From 352d8ff09ce0f93846cef3e4537996f5998f8702 Mon Sep 17 00:00:00 2001 From: Gil Mizrahi Date: Tue, 4 Apr 2023 17:01:17 +0300 Subject: [PATCH] validate logical models custom return type against postgres PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8563 GitOrigin-RevId: 462a608e0e90d1923bc1d735257f4506825f5db1 --- metadata.openapi.json | 49 ---- server/lib/api-tests/api-tests.cabal | 2 + .../LogicalModels/TypeCheckingSpec.hs | 251 ++++++++++++++++++ .../Metadata/LogicalModels/ValidationSpec.hs | 4 +- .../Test/API/Metadata/LogicalModelsSpec.hs | 14 +- .../LogicalModels/LogicalModelsQueriesSpec.hs | 6 +- .../src/Database/PG/Query/Connection.hs | 38 +++ .../pg-client/src/Database/PG/Query/PTI.hs | 34 ++- .../src/Database/PG/Query/Transaction.hs | 15 ++ .../test-harness/src/Harness/Backend/Citus.hs | 2 +- .../src/Harness/Backend/Cockroach.hs | 2 +- .../src/Harness/Backend/Postgres.hs | 2 +- .../Postgres/Instances/LogicalModels.hs | 107 ++++++-- .../Backends/Postgres/Instances/Metadata.hs | 62 ++++- server/src-lib/Hasura/LogicalModel/API.hs | 11 +- .../LogicalModels/LogicalModelsSpec.hs | 46 ++-- 16 files changed, 532 insertions(+), 113 deletions(-) create mode 100644 server/lib/api-tests/src/Test/API/Metadata/LogicalModels/TypeCheckingSpec.hs diff --git a/metadata.openapi.json b/metadata.openapi.json index 13bdc2398fe..344f1044faf 100644 --- a/metadata.openapi.json +++ b/metadata.openapi.json @@ -835,13 +835,6 @@ "root_field_name": { "description": "Root field name for the logical model", "type": "string" - }, - "select_permissions": { - "default": [], - "items": { - "$ref": "#/components/schemas/BigquerySelectPermDef" - }, - "type": "array" } }, "required": [ @@ -1674,13 +1667,6 @@ "root_field_name": { "description": "Root field name for the logical model", "type": "string" - }, - "select_permissions": { - "default": [], - "items": { - "$ref": "#/components/schemas/CitusSelectPermDef" - }, - "type": "array" } }, "required": [ @@ -2548,13 +2534,6 @@ "root_field_name": { "description": "Root field name for the logical model", "type": "string" - }, - "select_permissions": { - "default": [], - "items": { - "$ref": "#/components/schemas/CockroachSelectPermDef" - }, - "type": "array" } }, "required": [ @@ -3577,13 +3556,6 @@ "root_field_name": { "description": "Root field name for the logical model", "type": "string" - }, - "select_permissions": { - "default": [], - "items": { - "$ref": "#/components/schemas/DataconnectorSelectPermDef" - }, - "type": "array" } }, "required": [ @@ -5076,13 +5048,6 @@ "root_field_name": { "description": "Root field name for the logical model", "type": "string" - }, - "select_permissions": { - "default": [], - "items": { - "$ref": "#/components/schemas/MssqlSelectPermDef" - }, - "type": "array" } }, "required": [ @@ -5913,13 +5878,6 @@ "root_field_name": { "description": "Root field name for the logical model", "type": "string" - }, - "select_permissions": { - "default": [], - "items": { - "$ref": "#/components/schemas/MysqlSelectPermDef" - }, - "type": "array" } }, "required": [ @@ -7051,13 +7009,6 @@ "root_field_name": { "description": "Root field name for the logical model", "type": "string" - }, - "select_permissions": { - "default": [], - "items": { - "$ref": "#/components/schemas/PostgresSelectPermDef" - }, - "type": "array" } }, "required": [ diff --git a/server/lib/api-tests/api-tests.cabal b/server/lib/api-tests/api-tests.cabal index 65712c5c6f5..e6506fb12be 100644 --- a/server/lib/api-tests/api-tests.cabal +++ b/server/lib/api-tests/api-tests.cabal @@ -87,6 +87,7 @@ library , uuid , vector , time + , QuickCheck exposed-modules: Spec @@ -98,6 +99,7 @@ library Test.API.Metadata.CustomTypeSpec Test.API.Metadata.InconsistentSpec Test.API.Metadata.LogicalModelsSpec + Test.API.Metadata.LogicalModels.TypeCheckingSpec Test.API.Metadata.LogicalModels.ValidationSpec Test.API.Metadata.SuggestRelationshipsSpec Test.API.Metadata.TestConnectionTemplateSpec diff --git a/server/lib/api-tests/src/Test/API/Metadata/LogicalModels/TypeCheckingSpec.hs b/server/lib/api-tests/src/Test/API/Metadata/LogicalModels/TypeCheckingSpec.hs new file mode 100644 index 00000000000..01526d055e4 --- /dev/null +++ b/server/lib/api-tests/src/Test/API/Metadata/LogicalModels/TypeCheckingSpec.hs @@ -0,0 +1,251 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} + +-- | Check the typechecking validation of logical model's custom return types. +module Test.API.Metadata.LogicalModels.TypeCheckingSpec where + +import Data.List.NonEmpty qualified as NE +import Harness.Backend.Citus qualified as Citus +import Harness.Backend.Cockroach qualified as Cockroach +import Harness.Backend.Postgres qualified as Postgres +import Harness.Exceptions (SomeException, catch) +import Harness.GraphqlEngine qualified as GraphqlEngine +import Harness.Quoter.Yaml (yaml) +import Harness.Schema qualified as Schema +import Harness.Test.BackendType qualified as BackendType +import Harness.Test.Fixture qualified as Fixture +import Harness.TestEnvironment (GlobalTestEnvironment, TestEnvironment, getBackendTypeConfig) +import Harness.Yaml (shouldAtLeastBe, shouldReturnYaml) +import Hasura.Prelude +import Hasura.SQL.Backend (PostgresKind (..)) +import Test.Hspec (SpecWith, describe, it) +import Test.QuickCheck + +featureFlagForLogicalModels :: String +featureFlagForLogicalModels = "HASURA_FF_LOGICAL_MODEL_INTERFACE" + +spec :: SpecWith GlobalTestEnvironment +spec = do + Fixture.hgeWithEnv [(featureFlagForLogicalModels, "True")] do + Fixture.run + ( NE.fromList + [ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata) + { Fixture.setupTeardown = \(testEnv, _) -> + [ Postgres.setupTablesAction schema testEnv + ] + }, + (Fixture.fixture $ Fixture.Backend Citus.backendTypeMetadata) + { Fixture.setupTeardown = \(testEnv, _) -> + [ Citus.setupTablesAction schema testEnv + ] + } + ] + ) + (tests @'Vanilla) + Fixture.run + ( NE.fromList + [ (Fixture.fixture $ Fixture.Backend Cockroach.backendTypeMetadata) + { Fixture.setupTeardown = \(testEnv, _) -> + [ Cockroach.setupTablesAction schema testEnv + ] + } + ] + ) + (tests @'Cockroach) + +-- ** Setup and teardown + +customType :: Text -> Schema.ScalarType +customType txt = + Schema.TCustomType + Schema.defaultBackendScalarType + { Schema.bstPostgres = Just txt, + Schema.bstCitus = Just txt, + Schema.bstCockroach = Just txt + } + +schema :: [Schema.Table] +schema = + [ (Schema.table "stuff") + { Schema.tableColumns = + (\t -> Schema.column t (customType t)) <$> types + } + ] + <> fmap + ( \t -> + (Schema.table ("stuff_" <> t)) + { Schema.tableColumns = + [Schema.column t (customType t)] + } + ) + types + +allTypesReturnType :: Schema.CustomType +allTypesReturnType = + (Schema.customType "stuff_type") + { Schema.customTypeColumns = + (\t -> Schema.logicalModelColumn t (customType t)) <$> types + } + +types :: [Text] +types = + [ "int2", + "smallint", + "integer", + "bigint", + "int8", + "real", + "float8", + "numeric", + "bool", + "char", + "varchar", + "text", + "date", + "timestamp", + "timestamptz", + "timetz", + "json", + "jsonb", + "uuid" + ] + +-- ** Tests + +tests :: forall pgKind. GetDiffs pgKind => SpecWith TestEnvironment +tests = do + describe "Validation succeeds tracking a logical model" do + it "for all supported types" $ + \testEnvironment -> do + let backendTypeMetadata = fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnvironment + sourceName = BackendType.backendSourceName backendTypeMetadata + + let simpleQuery :: Text + simpleQuery = "SELECT * FROM stuff" + + let logicalModel :: Schema.LogicalModel + logicalModel = + (Schema.logicalModel "typed_model" simpleQuery "stuff_type") + + Schema.trackCustomType sourceName allTypesReturnType testEnvironment + + shouldReturnYaml + testEnvironment + ( GraphqlEngine.postMetadata + testEnvironment + (Schema.trackLogicalModelCommand sourceName backendTypeMetadata logicalModel) + ) + [yaml| + message: success + |] + + describe "Validation fails tracking a logical model" do + it "when there's a type mismatch" $ \testEnvironment -> withMaxSuccess (maxSuccesses @pgKind) $ \(TypeForQuickCheck {..} :: TypeForQuickCheck pgKind) -> do + let backendTypeMetadata = fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnvironment + sourceName = BackendType.backendSourceName backendTypeMetadata + + let wrongQuery :: Text + wrongQuery = "SELECT " <> tableType <> " AS " <> customtypeType <> " FROM stuff_" <> tableType + + let logicalModel :: Schema.LogicalModel + logicalModel = + (Schema.logicalModel ("typed_model_" <> customtypeType) wrongQuery ("stuff_type_" <> customtypeType)) + + -- Possible cleanup after last test that may have tracked this custom type + _ <- Schema.untrackLogicalModel sourceName logicalModel testEnvironment `catch` \(_ :: SomeException) -> pure () + _ <- Schema.untrackCustomType sourceName (mkCustomType customtypeType) testEnvironment `catch` \(_ :: SomeException) -> pure () + Schema.trackCustomType sourceName (mkCustomType customtypeType) testEnvironment + + let message :: Text + message = + "Return column '" + <> customtypeType + <> "' has a type mismatch. The expected type is '" + <> customTypeNameMapping @pgKind customtypeType + <> "', but the actual type is '" + <> tableTypeNameMapping @pgKind tableType + <> "'." + expected = + [yaml| + code: validation-failed + error: Failed to validate query + internal: *message + |] + + actual <- + GraphqlEngine.postMetadataWithStatus + 400 + testEnvironment + (Schema.trackLogicalModelCommand sourceName backendTypeMetadata logicalModel) + actual `shouldAtLeastBe` expected + +-- ** Utils + +mkCustomType :: Text -> Schema.CustomType +mkCustomType typ = + (Schema.customType ("stuff_type_" <> typ)) + { Schema.customTypeColumns = + [Schema.logicalModelColumn typ (customType typ)] + } + +isDifferentTypeThanPg :: Text -> Text -> Bool +isDifferentTypeThanPg a b + | a == b = False + | ["int2", "smallint"] == sort [a, b] = False + | ["bigint", "int8"] == sort [a, b] = False + | otherwise = True + +isDifferentTypeThanRoach :: Text -> Text -> Bool +isDifferentTypeThanRoach a b + | a == b = False + | sort ["smallint", "int2"] == sort [a, b] = False + | sort ["integer", "int8"] == sort [a, b] = False + | sort ["bigint", "int8"] == sort [a, b] = False + | sort ["bigint", "integer"] == sort [a, b] = False + | sort ["json", "jsonb"] == sort [a, b] = False + | otherwise = True + +data TypeForQuickCheck pgKind = TypeForQuickCheck {tableType :: Text, customtypeType :: Text} + deriving (Show) + +instance GetDiffs pgKind => Arbitrary (TypeForQuickCheck pgKind) where + shrink = const [] + arbitrary = + uncurry TypeForQuickCheck + <$> suchThat ((,) <$> elements types <*> elements types) (uncurry (isDifferentTypeThan @pgKind)) + +class GetDiffs (pgKind :: PostgresKind) where + maxSuccesses :: Int + maxSuccesses = 100 + isDifferentTypeThan :: Text -> Text -> Bool + isDifferentTypeThan = isDifferentTypeThanPg + customTypeNameMapping :: Text -> Text + customTypeNameMapping = tableTypeNameMapping @pgKind + tableTypeNameMapping :: Text -> Text + tableTypeNameMapping = \case + "bool" -> "boolean" + "char" -> "bpchar" + "int2" -> "smallint" + "int8" -> "bigint" + t -> t + +instance GetDiffs 'Vanilla + +instance GetDiffs 'Citus + +instance GetDiffs 'Cockroach where + maxSuccesses = 30 + isDifferentTypeThan = isDifferentTypeThanRoach + customTypeNameMapping = \case + "bool" -> "boolean" + "char" -> "bpchar" + "int2" -> "smallint" + "int8" -> "bigint" + t -> t + tableTypeNameMapping = \case + "bool" -> "boolean" + "char" -> "bpchar" + "int2" -> "smallint" + "integer" -> "bigint" + "int8" -> "bigint" + "json" -> "jsonb" + t -> t diff --git a/server/lib/api-tests/src/Test/API/Metadata/LogicalModels/ValidationSpec.hs b/server/lib/api-tests/src/Test/API/Metadata/LogicalModels/ValidationSpec.hs index 60c88e2efbb..9407d1c3a32 100644 --- a/server/lib/api-tests/src/Test/API/Metadata/LogicalModels/ValidationSpec.hs +++ b/server/lib/api-tests/src/Test/API/Metadata/LogicalModels/ValidationSpec.hs @@ -58,7 +58,7 @@ schema = tests :: SpecWith TestEnvironment tests = do let simpleQuery :: Text - simpleQuery = "SELECT thing / 2 AS divided FROM stuff" + simpleQuery = "SELECT (thing / 2)::integer AS divided FROM stuff" conflictingReturnType :: Schema.CustomType conflictingReturnType = @@ -204,7 +204,7 @@ tests = do ) [yaml| code: unexpected - error: *expectedError + error: *expectedError path: $.args |] diff --git a/server/lib/api-tests/src/Test/API/Metadata/LogicalModelsSpec.hs b/server/lib/api-tests/src/Test/API/Metadata/LogicalModelsSpec.hs index fdd86da5922..255ba681f9e 100644 --- a/server/lib/api-tests/src/Test/API/Metadata/LogicalModelsSpec.hs +++ b/server/lib/api-tests/src/Test/API/Metadata/LogicalModelsSpec.hs @@ -100,7 +100,7 @@ dividedStuffReturnType = testAdminAccess :: SpecWith TestEnvironment testAdminAccess = do let query :: Text - query = "SELECT thing / {{denominator}} AS divided FROM stuff WHERE date = {{target_date}}" + query = "SELECT (thing / {{denominator}})::integer AS divided FROM stuff WHERE date = {{target_date}}" describe "Admin access" do let dividedStuffLogicalModel :: Schema.LogicalModel @@ -171,7 +171,7 @@ testAdminAccess = do [ ("X-Hasura-Role", "not-admin") ] [yaml| - type: *getRequestType + type: *getRequestType args: source: *sourceName |] @@ -189,10 +189,10 @@ testAdminAccess = do testImplementation :: SpecWith TestEnvironment testImplementation = do let simpleQuery :: Text - simpleQuery = "SELECT thing / 2 AS divided FROM stuff" + simpleQuery = "SELECT (thing / 2)::integer AS divided FROM stuff" - query :: Text - query = "SELECT thing / {{denominator}} AS divided FROM stuff WHERE date = {{target_date}}" + let query :: Text + query = "SELECT (thing / {{denominator}})::integer AS divided FROM stuff WHERE date = {{target_date}}" describe "Implementation" $ do it "Adds a simple logical model of a function with no arguments and returns a 200" $ \testEnvironment -> do @@ -260,7 +260,7 @@ testImplementation = do ( GraphqlEngine.postMetadata testEnvironment [yaml| - type: *getRequestType + type: *getRequestType args: source: *sourceName |] @@ -321,7 +321,7 @@ testImplementation = do ( GraphqlEngine.postMetadata testEnvironment [yaml| - type: *getRequestType + type: *getRequestType args: source: *sourceName |] diff --git a/server/lib/api-tests/src/Test/Queries/LogicalModels/LogicalModelsQueriesSpec.hs b/server/lib/api-tests/src/Test/Queries/LogicalModels/LogicalModelsQueriesSpec.hs index 4d123c7a0ce..395f6af24d8 100644 --- a/server/lib/api-tests/src/Test/Queries/LogicalModels/LogicalModelsQueriesSpec.hs +++ b/server/lib/api-tests/src/Test/Queries/LogicalModels/LogicalModelsQueriesSpec.hs @@ -122,7 +122,7 @@ tests = do let backendTypeMetadata = fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnvironment sourceName = BackendType.backendSourceName backendTypeMetadata - nullableQuery = "SELECT thing / 2 AS divided, null as something_nullable FROM stuff" + nullableQuery = "SELECT (thing / 2)::integer AS divided, null::text as something_nullable FROM stuff" descriptionsAndNullableReturnType :: Schema.CustomType descriptionsAndNullableReturnType = @@ -131,7 +131,7 @@ tests = do [ (Schema.logicalModelColumn "divided" Schema.TInt) { Schema.logicalModelColumnDescription = Just "A divided thing" }, - (Schema.logicalModelColumn "something_nullable" Schema.TInt) + (Schema.logicalModelColumn "something_nullable" Schema.TStr) { Schema.logicalModelColumnDescription = Just "Something nullable", Schema.logicalModelColumnNullable = True } @@ -196,7 +196,7 @@ tests = do "name": "something_nullable", "type": { "kind": "SCALAR", - "name": "Int", + "name": "String", "ofType": null } } diff --git a/server/lib/pg-client/src/Database/PG/Query/Connection.hs b/server/lib/pg-client/src/Database/PG/Query/Connection.hs index f585c075622..4b8d29efb37 100644 --- a/server/lib/pg-client/src/Database/PG/Query/Connection.hs +++ b/server/lib/pg-client/src/Database/PG/Query/Connection.hs @@ -39,6 +39,8 @@ module Database.PG.Query.Connection lenientDecodeUtf8, PGErrInternal (..), PGStmtErrDetail (..), + describePrepared, + PreparedDescription (..), ) where @@ -567,3 +569,39 @@ execMulti pgConn (Template t) convF = do withExceptT PGIUnexpected $ convF resOk where PGConn conn _ cancelable _ _ _ _ _ _ = pgConn + +-- | Extract the description of a prepared statement. +describePrepared :: + PGConn -> + ByteString -> + ExceptT PGErrInternal IO (PreparedDescription PQ.Oid) +describePrepared pgConn name = do + resOk <- retryOnConnErr pgConn $ do + mRes <- + bool lift (cancelOnAsync (pgPQConn pgConn)) (pgCancel pgConn) $ + PQ.describePrepared (pgPQConn pgConn) name + checkResult (pgPQConn pgConn) mRes + + let res = getPQRes resOk + lift $ do + numberOfParams <- PQ.nparams res + numberOfFields <- PQ.nfields res + PreparedDescription + <$> traverse (PQ.paramtype res) [0 .. (numberOfParams - 1)] + <*> traverse + ( \i -> + (,) + <$> PQ.fname res i + <*> PQ.ftype res i + ) + [0 .. (numberOfFields - 1)] + +-- | The description of a prepared statement. +-- See "PQdescribePrepared" in for more information. +data PreparedDescription typ = PreparedDescription + { -- | input parameters + pd_paramtype :: [typ], + -- | output columns + pd_fname_ftype :: [(Maybe ByteString, typ)] + } + deriving stock (Eq, Show) diff --git a/server/lib/pg-client/src/Database/PG/Query/PTI.hs b/server/lib/pg-client/src/Database/PG/Query/PTI.hs index e065d059741..3bc14cc22fc 100644 --- a/server/lib/pg-client/src/Database/PG/Query/PTI.hs +++ b/server/lib/pg-client/src/Database/PG/Query/PTI.hs @@ -167,6 +167,38 @@ xml = mkOid 142 -- Array Types -text_arr = mkOid 1009 +bool_array = mkOid 1000 + +char_array = mkOid 1002 + +int2_array = mkOid 1005 + +int4_array = mkOid 1007 + +text_array = mkOid 1009 + +varchar_array = mkOid 1015 + +int8_array = mkOid 1016 + +float4_array = mkOid 1021 + +float8_array = mkOid 1022 + +numeric_array = mkOid 1031 + +timestamp_array = mkOid 1115 + +date_array = mkOid 1182 + +time_array = mkOid 1183 + +timestamptz_array = mkOid 1185 + +timetz_array = mkOid 1270 + +json_array = mkOid 199 jsonb_array = mkOid 3807 + +uuid_array = mkOid 2951 diff --git a/server/lib/pg-client/src/Database/PG/Query/Transaction.hs b/server/lib/pg-client/src/Database/PG/Query/Transaction.hs index 99df499659c..52a4e039434 100644 --- a/server/lib/pg-client/src/Database/PG/Query/Transaction.hs +++ b/server/lib/pg-client/src/Database/PG/Query/Transaction.hs @@ -29,6 +29,8 @@ module Database.PG.Query.Transaction fromText, fromBuilder, getQueryText, + describePreparedStatement, + PreparedDescription (..), ) where @@ -45,6 +47,7 @@ import Control.Monad.Trans.Except (ExceptT, withExceptT) import Control.Monad.Trans.Reader (ReaderT (..)) import Data.Aeson (ToJSON (toJSON), object, (.=)) import Data.Aeson.Text (encodeToLazyText) +import Data.ByteString (ByteString) import Data.Hashable (Hashable) import Data.String (IsString) import Data.Text (Text) @@ -209,6 +212,18 @@ discardQE ef t r p = do Discard () <- withQE ef t r p return () +-- | Extract the description of a prepared statement. +describePreparedStatement :: + (MonadIO m) => + (PGTxErr -> e) -> + ByteString -> + TxET e m (PreparedDescription PQ.Oid) +describePreparedStatement ef name = TxET $ + ReaderT $ \pgConn -> + withExceptT (ef . PGTxErr mempty [] False) $ + hoist liftIO $ + describePrepared pgConn name + serverVersion :: MonadIO m => TxET e m Int serverVersion = do diff --git a/server/lib/test-harness/src/Harness/Backend/Citus.hs b/server/lib/test-harness/src/Harness/Backend/Citus.hs index 9dbdbad87d0..4367c62e59f 100644 --- a/server/lib/test-harness/src/Harness/Backend/Citus.hs +++ b/server/lib/test-harness/src/Harness/Backend/Citus.hs @@ -168,7 +168,7 @@ createTable testEnv Schema.Table {tableName, tableColumns, tablePrimaryKey = pk, scalarType :: HasCallStack => Schema.ScalarType -> Text scalarType = \case Schema.TInt -> "integer" - Schema.TStr -> "varchar" + Schema.TStr -> "text" Schema.TUTCTime -> "timestamp" Schema.TBool -> "boolean" Schema.TGeography -> "geography" diff --git a/server/lib/test-harness/src/Harness/Backend/Cockroach.hs b/server/lib/test-harness/src/Harness/Backend/Cockroach.hs index 63be92f1cfd..6ffffd32986 100644 --- a/server/lib/test-harness/src/Harness/Backend/Cockroach.hs +++ b/server/lib/test-harness/src/Harness/Backend/Cockroach.hs @@ -169,7 +169,7 @@ createTable testEnv Schema.Table {tableName, tableColumns, tablePrimaryKey = pk, scalarType :: HasCallStack => Schema.ScalarType -> Text scalarType = \case Schema.TInt -> "integer" - Schema.TStr -> "varchar" + Schema.TStr -> "text" Schema.TUTCTime -> "timestamp" Schema.TBool -> "boolean" Schema.TGeography -> "geography" diff --git a/server/lib/test-harness/src/Harness/Backend/Postgres.hs b/server/lib/test-harness/src/Harness/Backend/Postgres.hs index f775c149624..10a34945f61 100644 --- a/server/lib/test-harness/src/Harness/Backend/Postgres.hs +++ b/server/lib/test-harness/src/Harness/Backend/Postgres.hs @@ -282,7 +282,7 @@ createUniqueIndexSql (SchemaName schemaName) tableName = \case scalarType :: HasCallStack => Schema.ScalarType -> Text scalarType = \case Schema.TInt -> "integer" - Schema.TStr -> "varchar" + Schema.TStr -> "text" Schema.TUTCTime -> "timestamp" Schema.TBool -> "boolean" Schema.TGeography -> "geography" diff --git a/server/src-lib/Hasura/Backends/Postgres/Instances/LogicalModels.hs b/server/src-lib/Hasura/Backends/Postgres/Instances/LogicalModels.hs index d719d4168d9..9d533ecb6bd 100644 --- a/server/src-lib/Hasura/Backends/Postgres/Instances/LogicalModels.hs +++ b/server/src-lib/Hasura/Backends/Postgres/Instances/LogicalModels.hs @@ -6,6 +6,8 @@ module Hasura.Backends.Postgres.Instances.LogicalModels where import Data.Aeson (toJSON) +import Data.Bifunctor +import Data.ByteString qualified as BS import Data.Environment qualified as Env import Data.HashMap.Strict qualified as HashMap import Data.HashMap.Strict.InsOrd qualified as InsOrd @@ -14,12 +16,15 @@ import Data.Map.Strict qualified as Map import Data.Set (Set) import Data.Set qualified as Set import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text import Data.Text.Extended (commaSeparated, toTxt) +import Data.Tuple (swap) import Database.PG.Query qualified as PG +import Database.PostgreSQL.LibPQ qualified as PQ import Hasura.Backends.Postgres.Connection qualified as PG import Hasura.Backends.Postgres.Connection.Connect (withPostgresDB) import Hasura.Backends.Postgres.Instances.Types () -import Hasura.Backends.Postgres.SQL.Types (PGScalarType, pgScalarTypeToText) +import Hasura.Backends.Postgres.SQL.Types (PGScalarType (..), pgScalarTypeToText) import Hasura.Base.Error import Hasura.CustomReturnType.Metadata (CustomReturnTypeMetadata (..)) import Hasura.LogicalModel.Metadata @@ -36,39 +41,95 @@ import Hasura.SQL.Backend validateLogicalModel :: forall m pgKind. (MonadIO m, MonadError QErr m) => + InsOrd.InsOrdHashMap PGScalarType PQ.Oid -> Env.Environment -> PG.PostgresConnConfiguration -> CustomReturnTypeMetadata ('Postgres pgKind) -> LogicalModelMetadata ('Postgres pgKind) -> m () -validateLogicalModel env connConf customReturnType model = do - preparedQuery <- logicalModelToPreparedStatement customReturnType model - - -- We don't need to deallocate the prepared statement because 'withPostgresDB' - -- opens a new connection, runs a statement, and then closes the connection. - -- Since a prepared statement only lasts for the duration of the session, once - -- the session closes, the prepared statement is deallocated as well. - runRaw (PG.fromText $ preparedQuery) +validateLogicalModel pgTypeOidMapping env connConf customReturnType model = do + (prepname, preparedQuery) <- logicalModelToPreparedStatement customReturnType model + description <- runCheck prepname (PG.fromText preparedQuery) + let returnColumns = bimap toTxt nstType <$> InsOrd.toList (_crtmFields customReturnType) + for_ (toList returnColumns) (matchTypes description) where - runRaw :: PG.Query -> m () - runRaw stmt = + -- Run stuff against the database. + -- + -- We don't need to deallocate the prepared statement because 'withPostgresDB' + -- opens a new connection, runs a statement, and then closes the connection. + -- Since a prepared statement only lasts for the duration of the session, once + -- the session closes, the prepared statement is deallocated as well. + runCheck :: BS.ByteString -> PG.Query -> m (PG.PreparedDescription PQ.Oid) + runCheck prepname stmt = liftEither =<< liftIO ( withPostgresDB env connConf - ( PG.rawQE - ( \e -> - (err400 ValidationFailed "Failed to validate query") - { qeInternal = Just $ ExtraInternal $ toJSON e - } - ) - stmt - [] - False + ( do + -- prepare statement + PG.rawQE @_ @() + ( \e -> + (err400 ValidationFailed "Failed to validate query") + { qeInternal = Just $ ExtraInternal $ toJSON e + } + ) + stmt + [] + False + -- extract description + PG.describePreparedStatement + ( \e -> + (err400 ValidationFailed "Failed to validate query") + { qeInternal = Just $ ExtraInternal $ toJSON e + } + ) + prepname ) ) + -- Look for the type for a particular column in the prepared statement description + -- and compare them. + -- fail if not found, try to provide a good error message if you can. + matchTypes :: PG.PreparedDescription PQ.Oid -> (Text, PGScalarType) -> m () + matchTypes description (name, expectedType) = + case lookup (Just (Text.encodeUtf8 name)) (PG.pd_fname_ftype description) of + Nothing -> + throwError + (err400 ValidationFailed "Failed to validate query") + { qeInternal = + Just $ + ExtraInternal $ + toJSON @Text $ + "Column named '" <> toTxt name <> "' is not returned from the query." + } + Just actualOid + | Just expectedOid <- InsOrd.lookup expectedType pgTypeOidMapping, + expectedOid /= actualOid -> + throwError + (err400 ValidationFailed "Failed to validate query") + { qeInternal = + Just $ + ExtraInternal $ + toJSON @Text $ + Text.unwords $ + [ "Return column '" <> name <> "' has a type mismatch.", + "The expected type is '" <> toTxt expectedType <> "'," + ] + <> case Map.lookup actualOid (invertPgTypeOidMap pgTypeOidMapping) of + Just t -> + ["but the actual type is '" <> toTxt t <> "'."] + Nothing -> + [ "and has the " <> tshow expectedOid <> ",", + "but the actual type has the " <> tshow actualOid <> "." + ] + } + Just {} -> pure () + +-- | Invert the type/oid mapping. +invertPgTypeOidMap :: InsOrdHashMap PGScalarType PQ.Oid -> Map PQ.Oid PGScalarType +invertPgTypeOidMap = Map.fromList . map swap . InsOrd.toList + --------------------------------------- -- | The environment and fresh-name generator used by 'renameIQ'. @@ -121,8 +182,6 @@ renameIQ = runRenaming . fmap InterpolatedQuery . mapM renameII . getInterpolate -- Therefore we invert the map as part of renaming. inverseMap :: Ord b => Map a b -> Map b a inverseMap = Map.fromList . map swap . Map.toList - where - swap (a, b) = (b, a) -- | Pretty print an interpolated query with numbered parameters. renderIQ :: InterpolatedQuery Int -> Text @@ -142,7 +201,7 @@ logicalModelToPreparedStatement :: MonadError QErr m => CustomReturnTypeMetadata ('Postgres pgKind) -> LogicalModelMetadata ('Postgres pgKind) -> - m Text + m (BS.ByteString, Text) logicalModelToPreparedStatement customReturnType model = do let name = getLogicalModelName $ _lmmRootFieldName model let (preparedIQ, argumentMapping) = renameIQ $ _lmmCode model @@ -186,4 +245,4 @@ logicalModelToPreparedStatement customReturnType model = do err400 ValidationFailed $ "Undeclared arguments: " <> commaSeparated (map tshow $ Set.toList undeclaredArguments) - return preparedQuery + pure (Text.encodeUtf8 prepname, preparedQuery) diff --git a/server/src-lib/Hasura/Backends/Postgres/Instances/Metadata.hs b/server/src-lib/Hasura/Backends/Postgres/Instances/Metadata.hs index aee0b84c3c7..6296e878603 100644 --- a/server/src-lib/Hasura/Backends/Postgres/Instances/Metadata.hs +++ b/server/src-lib/Hasura/Backends/Postgres/Instances/Metadata.hs @@ -7,10 +7,14 @@ module Hasura.Backends.Postgres.Instances.Metadata () where import Data.HashMap.Strict qualified as Map +import Data.HashMap.Strict.InsOrd qualified as InsOrd import Data.Text.Extended +import Database.PG.Query.PTI qualified as PTI +import Database.PostgreSQL.LibPQ qualified as PQ import Hasura.Backends.Postgres.DDL qualified as Postgres import Hasura.Backends.Postgres.Instances.LogicalModels as Postgres (validateLogicalModel) import Hasura.Backends.Postgres.SQL.Types (QualifiedTable) +import Hasura.Backends.Postgres.SQL.Types qualified as Postgres import Hasura.Backends.Postgres.Types.CitusExtraTableMetadata import Hasura.Base.Error import Hasura.Prelude @@ -35,6 +39,55 @@ class PostgresMetadata (pgKind :: PostgresKind) where Either (ObjRelDef ('Postgres pgKind)) (ArrRelDef ('Postgres pgKind)) -> m () + -- | A mapping from pg scalar types with clear oid equivalent to oid. + -- + -- This is a insert order hash map so that when we invert it + -- duplicate oids will point to a more "general" type. + pgTypeOidMapping :: InsOrd.InsOrdHashMap Postgres.PGScalarType PQ.Oid + pgTypeOidMapping = + InsOrd.fromList $ + [ (Postgres.PGSmallInt, PTI.int2), + (Postgres.PGSerial, PTI.int4), + (Postgres.PGInteger, PTI.int4), + (Postgres.PGBigSerial, PTI.int8), + (Postgres.PGBigInt, PTI.int8), + (Postgres.PGFloat, PTI.float4), + (Postgres.PGDouble, PTI.float8), + (Postgres.PGMoney, PTI.numeric), + (Postgres.PGNumeric, PTI.numeric), + (Postgres.PGBoolean, PTI.bool), + (Postgres.PGChar, PTI.bpchar), + (Postgres.PGVarchar, PTI.varchar), + (Postgres.PGText, PTI.text), + (Postgres.PGDate, PTI.date), + (Postgres.PGTimeStamp, PTI.timestamp), + (Postgres.PGTimeStampTZ, PTI.timestamptz), + (Postgres.PGTimeTZ, PTI.timetz), + (Postgres.PGJSON, PTI.json), + (Postgres.PGJSONB, PTI.jsonb), + (Postgres.PGUUID, PTI.uuid), + (Postgres.PGArray Postgres.PGSmallInt, PTI.int2_array), + (Postgres.PGArray Postgres.PGSerial, PTI.int4_array), + (Postgres.PGArray Postgres.PGInteger, PTI.int4_array), + (Postgres.PGArray Postgres.PGBigSerial, PTI.int8_array), + (Postgres.PGArray Postgres.PGBigInt, PTI.int8_array), + (Postgres.PGArray Postgres.PGFloat, PTI.float4_array), + (Postgres.PGArray Postgres.PGDouble, PTI.float8_array), + (Postgres.PGArray Postgres.PGMoney, PTI.numeric_array), + (Postgres.PGArray Postgres.PGNumeric, PTI.numeric_array), + (Postgres.PGArray Postgres.PGBoolean, PTI.bool_array), + (Postgres.PGArray Postgres.PGChar, PTI.char_array), + (Postgres.PGArray Postgres.PGVarchar, PTI.varchar_array), + (Postgres.PGArray Postgres.PGText, PTI.text_array), + (Postgres.PGArray Postgres.PGDate, PTI.date_array), + (Postgres.PGArray Postgres.PGTimeStamp, PTI.timestamp_array), + (Postgres.PGArray Postgres.PGTimeStampTZ, PTI.timestamptz_array), + (Postgres.PGArray Postgres.PGTimeTZ, PTI.timetz_array), + (Postgres.PGArray Postgres.PGJSON, PTI.json_array), + (Postgres.PGArray Postgres.PGJSON, PTI.jsonb_array), + (Postgres.PGArray Postgres.PGUUID, PTI.uuid_array) + ] + instance PostgresMetadata 'Vanilla where validateRel _ _ _ = pure () @@ -112,6 +165,13 @@ instance PostgresMetadata 'Citus where instance PostgresMetadata 'Cockroach where validateRel _ _ _ = pure () + pgTypeOidMapping = + InsOrd.fromList + [ (Postgres.PGInteger, PTI.int8), + (Postgres.PGSerial, PTI.int8), + (Postgres.PGJSON, PTI.jsonb) + ] + `InsOrd.union` pgTypeOidMapping @'Vanilla ---------------------------------------------------------------- -- BackendMetadata instance @@ -137,5 +197,5 @@ instance postDropSourceHook = Postgres.postDropSourceHook validateRelationship = validateRel @pgKind buildComputedFieldBooleanExp = Postgres.buildComputedFieldBooleanExp - validateLogicalModel = Postgres.validateLogicalModel + validateLogicalModel = Postgres.validateLogicalModel (pgTypeOidMapping @pgKind) supportsBeingRemoteRelationshipTarget _ = True diff --git a/server/src-lib/Hasura/LogicalModel/API.hs b/server/src-lib/Hasura/LogicalModel/API.hs index fadc03293d8..cdcfbe8fe95 100644 --- a/server/src-lib/Hasura/LogicalModel/API.hs +++ b/server/src-lib/Hasura/LogicalModel/API.hs @@ -36,6 +36,7 @@ import Hasura.RQL.Types.Metadata.Object import Hasura.RQL.Types.SchemaCache.Build import Hasura.SQL.AnyBackend qualified as AB import Hasura.SQL.Backend +import Hasura.SQL.Tag import Hasura.Server.Init.FeatureFlag as FF import Hasura.Server.Types (HasServerConfigCtx (..), ServerConfigCtx (..)) @@ -179,7 +180,15 @@ runTrackLogicalModel env trackLogicalModelRequest = do throwIfFeatureDisabled sourceMetadata <- - maybe (throw400 NotFound $ "Source " <> sourceNameToText source <> " not found.") pure + maybe + ( throw400 NotFound $ + "Source '" + <> sourceNameToText source + <> "' of kind " + <> toTxt (reify (backendTag @b)) + <> " not found." + ) + pure . preview (metaSources . ix source . toSourceMetadata @b) =<< getMetadata let sourceConnConfig = _smConfiguration sourceMetadata diff --git a/server/src-test/Hasura/Backends/Postgres/LogicalModels/LogicalModelsSpec.hs b/server/src-test/Hasura/Backends/Postgres/LogicalModels/LogicalModelsSpec.hs index 727720a80af..461129118c0 100644 --- a/server/src-test/Hasura/Backends/Postgres/LogicalModels/LogicalModelsSpec.hs +++ b/server/src-test/Hasura/Backends/Postgres/LogicalModels/LogicalModelsSpec.hs @@ -86,7 +86,7 @@ spec = do it "Rejects undeclared variables" do let Right code = parseInterpolatedQuery "SELECT {{hey}}" - let actual :: Either QErr Text = runExcept $ logicalModelToPreparedStatement crtm lmm {_lmmCode = code} + let actual :: Either QErr Text = fmap snd $ runExcept $ logicalModelToPreparedStatement crtm lmm {_lmmCode = code} (first showQErr actual) `shouldSatisfy` isLeft let Left err = actual @@ -95,16 +95,17 @@ spec = do it "Handles multiple occurences of variables " do let Right code = parseInterpolatedQuery "SELECT {{hey}}, {{hey}}" let actual :: Either QErr Text = - runExcept $ - logicalModelToPreparedStatement - crtm - lmm - { _lmmCode = code, - _lmmArguments = - HM.fromList - [ (LogicalModelArgumentName "hey", NullableScalarType PGVarchar False Nothing) - ] - } + fmap snd $ + runExcept $ + logicalModelToPreparedStatement + crtm + lmm + { _lmmCode = code, + _lmmArguments = + HM.fromList + [ (LogicalModelArgumentName "hey", NullableScalarType PGVarchar False Nothing) + ] + } (first showQErr actual) `shouldSatisfy` isRight let Right rendered = actual @@ -114,17 +115,18 @@ spec = do it "Handles multiple variables " do let Right code = parseInterpolatedQuery "SELECT {{hey}}, {{ho}}" let actual :: Either QErr Text = - runExcept $ - logicalModelToPreparedStatement - crtm - lmm - { _lmmCode = code, - _lmmArguments = - HM.fromList - [ (LogicalModelArgumentName "hey", NullableScalarType PGVarchar False Nothing), - (LogicalModelArgumentName "ho", NullableScalarType PGInteger False Nothing) - ] - } + fmap snd $ + runExcept $ + logicalModelToPreparedStatement + crtm + lmm + { _lmmCode = code, + _lmmArguments = + HM.fromList + [ (LogicalModelArgumentName "hey", NullableScalarType PGVarchar False Nothing), + (LogicalModelArgumentName "ho", NullableScalarType PGInteger False Nothing) + ] + } (first showQErr actual) `shouldSatisfy` isRight let Right rendered = actual