mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-15 09:22:43 +03:00
server: Permit strings for numerical input fields
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5996 GitOrigin-RevId: 2ed36898aa0286618f3dafe3513ef4e01c58aaba
This commit is contained in:
parent
d1434e4932
commit
7739f8e4a0
server
@ -409,6 +409,7 @@ library
|
|||||||
, Hasura.Backends.BigQuery.Instances.Metadata
|
, Hasura.Backends.BigQuery.Instances.Metadata
|
||||||
, Hasura.Backends.BigQuery.Meta
|
, Hasura.Backends.BigQuery.Meta
|
||||||
, Hasura.Backends.BigQuery.Name
|
, Hasura.Backends.BigQuery.Name
|
||||||
|
, Hasura.Backends.BigQuery.Parser.Scalars
|
||||||
, Hasura.Backends.BigQuery.Plan
|
, Hasura.Backends.BigQuery.Plan
|
||||||
, Hasura.Backends.BigQuery.Source
|
, Hasura.Backends.BigQuery.Source
|
||||||
, Hasura.Backends.BigQuery.ToQuery
|
, Hasura.Backends.BigQuery.ToQuery
|
||||||
|
@ -366,7 +366,11 @@ initialiseServeCtx env GlobalCtx {..} so@ServeOptions {..} serverMetrics = do
|
|||||||
optimizePermissionFilters
|
optimizePermissionFilters
|
||||||
| EFOptimizePermissionFilters `elem` soExperimentalFeatures = Options.OptimizePermissionFilters
|
| EFOptimizePermissionFilters `elem` soExperimentalFeatures = Options.OptimizePermissionFilters
|
||||||
| otherwise = Options.Don'tOptimizePermissionFilters
|
| otherwise = Options.Don'tOptimizePermissionFilters
|
||||||
sqlGenCtx = SQLGenCtx soStringifyNum soDangerousBooleanCollapse optimizePermissionFilters
|
|
||||||
|
bigqueryStringNumericInput
|
||||||
|
| EFBigQueryStringNumericInput `elem` soExperimentalFeatures = Options.EnableBigQueryStringNumericInput
|
||||||
|
| otherwise = Options.DisableBigQueryStringNumericInput
|
||||||
|
sqlGenCtx = SQLGenCtx soStringifyNum soDangerousBooleanCollapse optimizePermissionFilters bigqueryStringNumericInput
|
||||||
|
|
||||||
let serverConfigCtx =
|
let serverConfigCtx =
|
||||||
ServerConfigCtx
|
ServerConfigCtx
|
||||||
@ -679,7 +683,12 @@ mkHGEServer setupHook env ServeOptions {..} ServeCtx {..} initTime postPollHook
|
|||||||
let optimizePermissionFilters
|
let optimizePermissionFilters
|
||||||
| EFOptimizePermissionFilters `elem` soExperimentalFeatures = Options.OptimizePermissionFilters
|
| EFOptimizePermissionFilters `elem` soExperimentalFeatures = Options.OptimizePermissionFilters
|
||||||
| otherwise = Options.Don'tOptimizePermissionFilters
|
| otherwise = Options.Don'tOptimizePermissionFilters
|
||||||
sqlGenCtx = SQLGenCtx soStringifyNum soDangerousBooleanCollapse optimizePermissionFilters
|
|
||||||
|
bigqueryStringNumericInput
|
||||||
|
| EFBigQueryStringNumericInput `elem` soExperimentalFeatures = Options.EnableBigQueryStringNumericInput
|
||||||
|
| otherwise = Options.DisableBigQueryStringNumericInput
|
||||||
|
|
||||||
|
sqlGenCtx = SQLGenCtx soStringifyNum soDangerousBooleanCollapse optimizePermissionFilters bigqueryStringNumericInput
|
||||||
Loggers loggerCtx logger _ = _scLoggers
|
Loggers loggerCtx logger _ = _scLoggers
|
||||||
|
|
||||||
authModeRes <-
|
authModeRes <-
|
||||||
|
@ -12,6 +12,7 @@ import Data.Text qualified as T
|
|||||||
import Data.Text.Casing qualified as C
|
import Data.Text.Casing qualified as C
|
||||||
import Data.Text.Extended
|
import Data.Text.Extended
|
||||||
import Hasura.Backends.BigQuery.Name
|
import Hasura.Backends.BigQuery.Name
|
||||||
|
import Hasura.Backends.BigQuery.Parser.Scalars qualified as BQP
|
||||||
import Hasura.Backends.BigQuery.Types qualified as BigQuery
|
import Hasura.Backends.BigQuery.Types qualified as BigQuery
|
||||||
import Hasura.Base.Error
|
import Hasura.Base.Error
|
||||||
import Hasura.Base.ErrorMessage (toErrorMessage)
|
import Hasura.Base.ErrorMessage (toErrorMessage)
|
||||||
@ -70,7 +71,7 @@ instance BackendSchema 'BigQuery where
|
|||||||
-- individual components
|
-- individual components
|
||||||
columnParser = bqColumnParser
|
columnParser = bqColumnParser
|
||||||
enumParser = bqEnumParser
|
enumParser = bqEnumParser
|
||||||
possiblyNullable = bqPossiblyNullable
|
possiblyNullable = const bqPossiblyNullable
|
||||||
scalarSelectionArgumentsParser _ = pure Nothing
|
scalarSelectionArgumentsParser _ = pure Nothing
|
||||||
orderByOperators _sourceInfo = bqOrderByOperators
|
orderByOperators _sourceInfo = bqOrderByOperators
|
||||||
comparisonExps = const bqComparisonExps
|
comparisonExps = const bqComparisonExps
|
||||||
@ -92,33 +93,54 @@ bqColumnParser ::
|
|||||||
ColumnType 'BigQuery ->
|
ColumnType 'BigQuery ->
|
||||||
G.Nullability ->
|
G.Nullability ->
|
||||||
SchemaT r m (Parser 'Both n (IR.ValueWithOrigin (ColumnValue 'BigQuery)))
|
SchemaT r m (Parser 'Both n (IR.ValueWithOrigin (ColumnValue 'BigQuery)))
|
||||||
bqColumnParser columnType nullability =
|
bqColumnParser columnType nullability = do
|
||||||
|
Options.SchemaOptions {soBigQueryStringNumericInput} <- asks getter
|
||||||
|
let numericInputParser :: forall a. a -> a -> a
|
||||||
|
numericInputParser builtin custom =
|
||||||
|
case soBigQueryStringNumericInput of
|
||||||
|
Options.EnableBigQueryStringNumericInput -> custom
|
||||||
|
Options.DisableBigQueryStringNumericInput -> builtin
|
||||||
peelWithOrigin . fmap (ColumnValue columnType) <$> case columnType of
|
peelWithOrigin . fmap (ColumnValue columnType) <$> case columnType of
|
||||||
ColumnScalar scalarType -> case scalarType of
|
ColumnScalar scalarType -> do
|
||||||
-- bytestrings
|
p <- case scalarType of
|
||||||
-- we only accept string literals
|
-- bytestrings
|
||||||
BigQuery.BytesScalarType -> pure $ bqPossiblyNullable scalarType nullability $ BigQuery.StringValue <$> stringBased _Bytes
|
-- we only accept string literals
|
||||||
-- text
|
BigQuery.BytesScalarType -> pure $ BigQuery.StringValue <$> stringBased _Bytes
|
||||||
BigQuery.StringScalarType -> pure $ bqPossiblyNullable scalarType nullability $ BigQuery.StringValue <$> P.string
|
-- text
|
||||||
-- floating point values
|
BigQuery.StringScalarType -> pure $ BigQuery.StringValue <$> P.string
|
||||||
-- TODO: we do not perform size checks here, meaning we would accept an
|
-- floating point values
|
||||||
-- out-of-bounds value as long as it can be represented by a GraphQL float; this
|
|
||||||
-- will in all likelihood error on the BigQuery side. Do we want to handle those
|
BigQuery.FloatScalarType ->
|
||||||
-- properly here?
|
pure $
|
||||||
BigQuery.FloatScalarType -> pure $ bqPossiblyNullable scalarType nullability $ BigQuery.FloatValue . BigQuery.doubleToFloat64 <$> P.float
|
BigQuery.FloatValue
|
||||||
BigQuery.IntegerScalarType -> pure $ bqPossiblyNullable scalarType nullability $ BigQuery.IntegerValue . BigQuery.intToInt64 . fromIntegral <$> P.int
|
<$> numericInputParser (BigQuery.doubleToFloat64 <$> P.float) BQP.bqFloat64
|
||||||
BigQuery.DecimalScalarType -> pure $ bqPossiblyNullable scalarType nullability $ BigQuery.DecimalValue . BigQuery.Decimal . BigQuery.scientificToText <$> P.scientific
|
BigQuery.IntegerScalarType ->
|
||||||
BigQuery.BigDecimalScalarType -> pure $ bqPossiblyNullable scalarType nullability $ BigQuery.BigDecimalValue . BigQuery.BigDecimal . BigQuery.scientificToText <$> P.scientific
|
pure $
|
||||||
-- boolean type
|
BigQuery.IntegerValue
|
||||||
BigQuery.BoolScalarType -> pure $ bqPossiblyNullable scalarType nullability $ BigQuery.BoolValue <$> P.boolean
|
<$> numericInputParser (BigQuery.intToInt64 . fromIntegral <$> P.int) BQP.bqInt64
|
||||||
BigQuery.DateScalarType -> pure $ bqPossiblyNullable scalarType nullability $ BigQuery.DateValue . BigQuery.Date <$> stringBased _Date
|
BigQuery.DecimalScalarType ->
|
||||||
BigQuery.TimeScalarType -> pure $ bqPossiblyNullable scalarType nullability $ BigQuery.TimeValue . BigQuery.Time <$> stringBased _Time
|
pure $
|
||||||
BigQuery.DatetimeScalarType -> pure $ bqPossiblyNullable scalarType nullability $ BigQuery.DatetimeValue . BigQuery.Datetime <$> stringBased _Datetime
|
BigQuery.DecimalValue
|
||||||
BigQuery.GeographyScalarType ->
|
<$> numericInputParser
|
||||||
pure $ bqPossiblyNullable scalarType nullability $ BigQuery.GeographyValue . BigQuery.Geography <$> throughJSON _Geography
|
(BigQuery.Decimal . BigQuery.scientificToText <$> P.scientific)
|
||||||
BigQuery.TimestampScalarType ->
|
BQP.bqDecimal
|
||||||
pure $ bqPossiblyNullable scalarType nullability $ BigQuery.TimestampValue . BigQuery.Timestamp <$> stringBased _Timestamp
|
BigQuery.BigDecimalScalarType ->
|
||||||
ty -> throwError $ internalError $ T.pack $ "Type currently unsupported for BigQuery: " ++ show ty
|
pure $
|
||||||
|
BigQuery.BigDecimalValue
|
||||||
|
<$> numericInputParser
|
||||||
|
(BigQuery.BigDecimal . BigQuery.scientificToText <$> P.scientific)
|
||||||
|
BQP.bqBigDecimal
|
||||||
|
-- boolean type
|
||||||
|
BigQuery.BoolScalarType -> pure $ BigQuery.BoolValue <$> P.boolean
|
||||||
|
BigQuery.DateScalarType -> pure $ BigQuery.DateValue . BigQuery.Date <$> stringBased _Date
|
||||||
|
BigQuery.TimeScalarType -> pure $ BigQuery.TimeValue . BigQuery.Time <$> stringBased _Time
|
||||||
|
BigQuery.DatetimeScalarType -> pure $ BigQuery.DatetimeValue . BigQuery.Datetime <$> stringBased _Datetime
|
||||||
|
BigQuery.GeographyScalarType ->
|
||||||
|
pure $ BigQuery.GeographyValue . BigQuery.Geography <$> throughJSON _Geography
|
||||||
|
BigQuery.TimestampScalarType ->
|
||||||
|
pure $ BigQuery.TimestampValue . BigQuery.Timestamp <$> stringBased _Timestamp
|
||||||
|
ty -> throwError $ internalError $ T.pack $ "Type currently unsupported for BigQuery: " ++ show ty
|
||||||
|
return $ bqPossiblyNullable nullability p
|
||||||
ColumnEnumReference (EnumReference tableName enumValues customTableName) ->
|
ColumnEnumReference (EnumReference tableName enumValues customTableName) ->
|
||||||
case nonEmpty (Map.toList enumValues) of
|
case nonEmpty (Map.toList enumValues) of
|
||||||
Just enumValuesList -> bqEnumParser tableName enumValuesList customTableName nullability
|
Just enumValuesList -> bqEnumParser tableName enumValuesList customTableName nullability
|
||||||
@ -145,7 +167,7 @@ bqEnumParser ::
|
|||||||
SchemaT r m (Parser 'Both n (ScalarValue 'BigQuery))
|
SchemaT r m (Parser 'Both n (ScalarValue 'BigQuery))
|
||||||
bqEnumParser tableName enumValues customTableName nullability = do
|
bqEnumParser tableName enumValues customTableName nullability = do
|
||||||
enumName <- mkEnumTypeName @'BigQuery tableName customTableName
|
enumName <- mkEnumTypeName @'BigQuery tableName customTableName
|
||||||
pure $ bqPossiblyNullable BigQuery.StringScalarType nullability $ P.enum enumName Nothing (mkEnumValue <$> enumValues)
|
pure $ bqPossiblyNullable nullability $ P.enum enumName Nothing (mkEnumValue <$> enumValues)
|
||||||
where
|
where
|
||||||
mkEnumValue :: (EnumValue, EnumValueInfo) -> (P.Definition P.EnumValueInfo, ScalarValue 'BigQuery)
|
mkEnumValue :: (EnumValue, EnumValueInfo) -> (P.Definition P.EnumValueInfo, ScalarValue 'BigQuery)
|
||||||
mkEnumValue (EnumValue value, EnumValueInfo description) =
|
mkEnumValue (EnumValue value, EnumValueInfo description) =
|
||||||
@ -155,11 +177,10 @@ bqEnumParser tableName enumValues customTableName nullability = do
|
|||||||
|
|
||||||
bqPossiblyNullable ::
|
bqPossiblyNullable ::
|
||||||
MonadParse m =>
|
MonadParse m =>
|
||||||
ScalarType 'BigQuery ->
|
|
||||||
G.Nullability ->
|
G.Nullability ->
|
||||||
Parser 'Both m (ScalarValue 'BigQuery) ->
|
Parser 'Both m (ScalarValue 'BigQuery) ->
|
||||||
Parser 'Both m (ScalarValue 'BigQuery)
|
Parser 'Both m (ScalarValue 'BigQuery)
|
||||||
bqPossiblyNullable _scalarType (G.Nullability isNullable)
|
bqPossiblyNullable (G.Nullability isNullable)
|
||||||
| isNullable = fmap (fromMaybe BigQuery.NullValue) . P.nullable
|
| isNullable = fmap (fromMaybe BigQuery.NullValue) . P.nullable
|
||||||
| otherwise = id
|
| otherwise = id
|
||||||
|
|
||||||
|
148
server/src-lib/Hasura/Backends/BigQuery/Parser/Scalars.hs
Normal file
148
server/src-lib/Hasura/Backends/BigQuery/Parser/Scalars.hs
Normal file
@ -0,0 +1,148 @@
|
|||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
|
||||||
|
-- | This module defines the scalars we use specific to the BigQuery
|
||||||
|
-- schema.
|
||||||
|
--
|
||||||
|
-- An idiosyncracy of BigQuery is that numbers serialized via JSON uses string
|
||||||
|
-- literals instead of number literals, because BigQuery handles wider-bit
|
||||||
|
-- numbers than JSON/JavaScript does.
|
||||||
|
--
|
||||||
|
-- Therefore, the BigQuery Backend uses bespoke parsers for numeric scalar
|
||||||
|
-- input, which accept string literals as well as number literals, such that we
|
||||||
|
-- preserve symmetry with with output formats.
|
||||||
|
module Hasura.Backends.BigQuery.Parser.Scalars
|
||||||
|
( bqInt64,
|
||||||
|
bqFloat64,
|
||||||
|
bqDecimal,
|
||||||
|
bqBigDecimal,
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Data.Aeson qualified as A
|
||||||
|
import Data.Int (Int64)
|
||||||
|
import Data.Scientific (Scientific)
|
||||||
|
import Data.Scientific qualified as S
|
||||||
|
import Data.Scientific qualified as Scientific
|
||||||
|
import Data.Text qualified as Text
|
||||||
|
import Hasura.Backends.BigQuery.Types qualified as BigQuery
|
||||||
|
import Hasura.Base.ErrorMessage (toErrorMessage)
|
||||||
|
import Hasura.Base.ErrorValue (dquote)
|
||||||
|
import Hasura.GraphQL.Parser.Class
|
||||||
|
import Hasura.GraphQL.Parser.ErrorCode
|
||||||
|
import Hasura.GraphQL.Parser.Internal.TypeChecking
|
||||||
|
import Hasura.GraphQL.Parser.Internal.Types
|
||||||
|
import Hasura.GraphQL.Parser.Schema
|
||||||
|
import Hasura.GraphQL.Parser.Variable
|
||||||
|
import Hasura.Prelude
|
||||||
|
import Language.GraphQL.Draft.Syntax hiding (Definition)
|
||||||
|
import Language.GraphQL.Draft.Syntax qualified as G
|
||||||
|
import Language.GraphQL.Draft.Syntax.QQ qualified as G
|
||||||
|
import Text.ParserCombinators.ReadP
|
||||||
|
|
||||||
|
bqInt64 :: forall origin m. MonadParse m => Parser origin 'Both m BigQuery.Int64
|
||||||
|
bqInt64 = mkScalar name "64-bit integers. Accepts both string and number literals." \case
|
||||||
|
GraphQLValue (VInt i)
|
||||||
|
| checkIntegerBounds i -> return $ BigQuery.Int64 (tshow i)
|
||||||
|
| otherwise -> boundsFailure (tshow i)
|
||||||
|
GraphQLValue (VString s) -> integralText s
|
||||||
|
JSONValue (A.String s) -> integralText s
|
||||||
|
JSONValue (A.Number n) -> integralSci (tshow n) n
|
||||||
|
v -> typeMismatch name "a 64-bit integer" v
|
||||||
|
where
|
||||||
|
name = [G.name|bigquery_int|]
|
||||||
|
|
||||||
|
checkIntegerBounds :: Integer -> Bool
|
||||||
|
checkIntegerBounds i = toInteger (minBound @Int64) <= i && i <= toInteger (maxBound @Int64)
|
||||||
|
|
||||||
|
integralText :: Text -> m BigQuery.Int64
|
||||||
|
integralText inputText
|
||||||
|
| [(sci, "")] <- readP_to_S Scientific.scientificP (Text.unpack inputText) = integralSci inputText sci
|
||||||
|
| otherwise = stringNotationError name inputText
|
||||||
|
|
||||||
|
integralSci :: Text -> Scientific -> m BigQuery.Int64
|
||||||
|
integralSci inputText sci
|
||||||
|
| Scientific.isInteger sci =
|
||||||
|
case Scientific.toBoundedInteger @Int64 sci of
|
||||||
|
Just v -> return $ BigQuery.intToInt64 v
|
||||||
|
Nothing -> boundsFailure inputText
|
||||||
|
| otherwise = integralFailure inputText
|
||||||
|
|
||||||
|
boundsFailure, integralFailure :: forall a. Text -> m a
|
||||||
|
boundsFailure inputText = parseErrorWith ParseFailed $ "The value " <> toErrorMessage inputText <> " lies outside the accepted numerical integral bounds."
|
||||||
|
integralFailure inputText = parseErrorWith ParseFailed $ "The value " <> toErrorMessage inputText <> " has a non-zero fractional part."
|
||||||
|
|
||||||
|
bqFloat64 :: forall origin m. MonadParse m => Parser origin 'Both m BigQuery.Float64
|
||||||
|
bqFloat64 = mkScalar name "64-bit floats. Accepts both string and number literals." \case
|
||||||
|
GraphQLValue (VFloat f) -> floatSci (tshow f) f
|
||||||
|
GraphQLValue (VInt i) -> floatSci (tshow i) (fromInteger i)
|
||||||
|
GraphQLValue (VString s) -> floatText s
|
||||||
|
JSONValue (A.String s) -> floatText s
|
||||||
|
JSONValue (A.Number n) -> floatSci (tshow n) n
|
||||||
|
v -> typeMismatch name "a 64-bit float" v
|
||||||
|
where
|
||||||
|
name = [G.name|bigquery_float|]
|
||||||
|
|
||||||
|
floatText :: Text -> m BigQuery.Float64
|
||||||
|
floatText inputText
|
||||||
|
| [(sci, "")] <- readP_to_S Scientific.scientificP (Text.unpack inputText) = floatSci inputText sci
|
||||||
|
| otherwise = stringNotationError name inputText
|
||||||
|
|
||||||
|
floatSci :: Text -> Scientific -> m BigQuery.Float64
|
||||||
|
floatSci inputText sci =
|
||||||
|
case Scientific.toBoundedRealFloat @Double sci of
|
||||||
|
Right v -> return $ BigQuery.doubleToFloat64 v
|
||||||
|
Left _ -> boundsFailure inputText
|
||||||
|
|
||||||
|
boundsFailure :: forall a. Text -> m a
|
||||||
|
boundsFailure inputText = parseErrorWith ParseFailed $ "The value " <> toErrorMessage inputText <> " lies outside the accepted numerical integral bounds."
|
||||||
|
|
||||||
|
bqBigDecimal :: MonadParse m => Parser origin 'Both m BigQuery.BigDecimal
|
||||||
|
bqBigDecimal = mkScalar name "BigDecimals. Accepts both string and number literals." $ fmap (BigQuery.BigDecimal . BigQuery.scientificToText) . decimal name
|
||||||
|
where
|
||||||
|
name = [G.name|bigquery_bigdecimal|]
|
||||||
|
|
||||||
|
bqDecimal :: MonadParse m => Parser origin 'Both m BigQuery.Decimal
|
||||||
|
bqDecimal = mkScalar name "Decimals. Accepts both string and number literals." $ fmap (BigQuery.Decimal . BigQuery.scientificToText) . decimal name
|
||||||
|
where
|
||||||
|
name = [G.name|bigquery_decimal|]
|
||||||
|
|
||||||
|
decimal :: MonadParse f => Name -> InputValue Variable -> f Scientific
|
||||||
|
decimal name = \case
|
||||||
|
GraphQLValue (VFloat f) -> pure f
|
||||||
|
GraphQLValue (VInt i) -> pure $ S.scientific i 0
|
||||||
|
GraphQLValue (VString s)
|
||||||
|
| Just sci <- readMaybe (Text.unpack s) -> pure $ sci
|
||||||
|
| otherwise -> stringNotationError name s
|
||||||
|
JSONValue (A.Number n) -> pure n
|
||||||
|
JSONValue (A.String s)
|
||||||
|
| Just sci <- readMaybe (Text.unpack s) -> pure $ sci
|
||||||
|
| otherwise -> stringNotationError name s
|
||||||
|
v -> typeMismatch name "decimal" v
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- Local helpers
|
||||||
|
|
||||||
|
mkScalar ::
|
||||||
|
MonadParse m =>
|
||||||
|
Name ->
|
||||||
|
Description ->
|
||||||
|
(InputValue Variable -> m a) ->
|
||||||
|
Parser origin 'Both m a
|
||||||
|
mkScalar name desc parser =
|
||||||
|
Parser
|
||||||
|
{ pType = schemaType,
|
||||||
|
pParser = peelVariable (toGraphQLType schemaType) >=> parser
|
||||||
|
}
|
||||||
|
where
|
||||||
|
schemaType = typeNamed name (Just desc)
|
||||||
|
|
||||||
|
typeNamed :: Name -> Maybe Description -> Type origin 'Both
|
||||||
|
typeNamed name description = TNamed NonNullable $ Definition name description Nothing [] TIScalar
|
||||||
|
|
||||||
|
stringNotationError :: MonadParse m => G.Name -> Text -> m a
|
||||||
|
stringNotationError typeName actualString =
|
||||||
|
parseError $
|
||||||
|
"expected " <> toErrorMessage (tshow typeName) <> " represented as a string, but got " <> dquote actualString
|
||||||
|
<> ", which is not a recognizable "
|
||||||
|
<> toErrorMessage (tshow typeName)
|
||||||
|
<> "."
|
@ -190,7 +190,7 @@ buildRoleContext ::
|
|||||||
G.SchemaIntrospection
|
G.SchemaIntrospection
|
||||||
)
|
)
|
||||||
buildRoleContext options sources remotes actions customTypes role remoteSchemaPermsCtx expFeatures = do
|
buildRoleContext options sources remotes actions customTypes role remoteSchemaPermsCtx expFeatures = do
|
||||||
let ( SQLGenCtx stringifyNum dangerousBooleanCollapse optimizePermissionFilters,
|
let ( SQLGenCtx stringifyNum dangerousBooleanCollapse optimizePermissionFilters bigqueryStringNumericInput,
|
||||||
functionPermsCtx
|
functionPermsCtx
|
||||||
) = options
|
) = options
|
||||||
schemaOptions =
|
schemaOptions =
|
||||||
@ -202,7 +202,8 @@ buildRoleContext options sources remotes actions customTypes role remoteSchemaPe
|
|||||||
soIncludeUpdateManyFields =
|
soIncludeUpdateManyFields =
|
||||||
if EFHideUpdateManyFields `Set.member` expFeatures
|
if EFHideUpdateManyFields `Set.member` expFeatures
|
||||||
then Options.DontIncludeUpdateManyFields
|
then Options.DontIncludeUpdateManyFields
|
||||||
else Options.IncludeUpdateManyFields
|
else Options.IncludeUpdateManyFields,
|
||||||
|
soBigQueryStringNumericInput = bigqueryStringNumericInput
|
||||||
}
|
}
|
||||||
schemaContext =
|
schemaContext =
|
||||||
SchemaContext
|
SchemaContext
|
||||||
@ -354,7 +355,7 @@ buildRelayRoleContext ::
|
|||||||
Set.HashSet ExperimentalFeature ->
|
Set.HashSet ExperimentalFeature ->
|
||||||
m (RoleContext GQLContext)
|
m (RoleContext GQLContext)
|
||||||
buildRelayRoleContext options sources actions customTypes role expFeatures = do
|
buildRelayRoleContext options sources actions customTypes role expFeatures = do
|
||||||
let ( SQLGenCtx stringifyNum dangerousBooleanCollapse optimizePermissionFilters,
|
let ( SQLGenCtx stringifyNum dangerousBooleanCollapse optimizePermissionFilters bigqueryStringNumericInput,
|
||||||
functionPermsCtx
|
functionPermsCtx
|
||||||
) = options
|
) = options
|
||||||
schemaOptions =
|
schemaOptions =
|
||||||
@ -366,7 +367,8 @@ buildRelayRoleContext options sources actions customTypes role expFeatures = do
|
|||||||
soIncludeUpdateManyFields =
|
soIncludeUpdateManyFields =
|
||||||
if EFHideUpdateManyFields `Set.member` expFeatures
|
if EFHideUpdateManyFields `Set.member` expFeatures
|
||||||
then Options.DontIncludeUpdateManyFields
|
then Options.DontIncludeUpdateManyFields
|
||||||
else Options.IncludeUpdateManyFields
|
else Options.IncludeUpdateManyFields,
|
||||||
|
soBigQueryStringNumericInput = bigqueryStringNumericInput
|
||||||
}
|
}
|
||||||
-- TODO: At the time of writing this, remote schema queries are not supported in relay.
|
-- TODO: At the time of writing this, remote schema queries are not supported in relay.
|
||||||
-- When they are supported, we should get do what `buildRoleContext` does. Since, they
|
-- When they are supported, we should get do what `buildRoleContext` does. Since, they
|
||||||
|
@ -8,6 +8,7 @@ module Hasura.GraphQL.Schema.Options
|
|||||||
RemoteSchemaPermissions (..),
|
RemoteSchemaPermissions (..),
|
||||||
OptimizePermissionFilters (..),
|
OptimizePermissionFilters (..),
|
||||||
IncludeUpdateManyFields (..),
|
IncludeUpdateManyFields (..),
|
||||||
|
BigQueryStringNumericInput (..),
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -21,7 +22,8 @@ data SchemaOptions = SchemaOptions
|
|||||||
soDangerousBooleanCollapse :: DangerouslyCollapseBooleans,
|
soDangerousBooleanCollapse :: DangerouslyCollapseBooleans,
|
||||||
soInferFunctionPermissions :: InferFunctionPermissions,
|
soInferFunctionPermissions :: InferFunctionPermissions,
|
||||||
soOptimizePermissionFilters :: OptimizePermissionFilters,
|
soOptimizePermissionFilters :: OptimizePermissionFilters,
|
||||||
soIncludeUpdateManyFields :: IncludeUpdateManyFields
|
soIncludeUpdateManyFields :: IncludeUpdateManyFields,
|
||||||
|
soBigQueryStringNumericInput :: BigQueryStringNumericInput
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Should we represent numbers in our responses as numbers, or strings?
|
-- | Should we represent numbers in our responses as numbers, or strings?
|
||||||
@ -106,3 +108,9 @@ data OptimizePermissionFilters
|
|||||||
= OptimizePermissionFilters
|
= OptimizePermissionFilters
|
||||||
| Don'tOptimizePermissionFilters
|
| Don'tOptimizePermissionFilters
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Should we enable string-accepting scalar parsers for BigQuery sources
|
||||||
|
data BigQueryStringNumericInput
|
||||||
|
= EnableBigQueryStringNumericInput
|
||||||
|
| DisableBigQueryStringNumericInput
|
||||||
|
deriving (Eq, Show)
|
||||||
|
@ -260,7 +260,8 @@ isSystemDefined = unSystemDefined
|
|||||||
data SQLGenCtx = SQLGenCtx
|
data SQLGenCtx = SQLGenCtx
|
||||||
{ stringifyNum :: Options.StringifyNumbers,
|
{ stringifyNum :: Options.StringifyNumbers,
|
||||||
dangerousBooleanCollapse :: Options.DangerouslyCollapseBooleans,
|
dangerousBooleanCollapse :: Options.DangerouslyCollapseBooleans,
|
||||||
optimizePermissionFilters :: Options.OptimizePermissionFilters
|
optimizePermissionFilters :: Options.OptimizePermissionFilters,
|
||||||
|
bigqueryStringNumericInput :: Options.BigQueryStringNumericInput
|
||||||
}
|
}
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
@ -250,10 +250,11 @@ instance FromEnv (HashSet Server.Types.ExperimentalFeature) where
|
|||||||
"naming_convention" -> Right Server.Types.EFNamingConventions
|
"naming_convention" -> Right Server.Types.EFNamingConventions
|
||||||
"apollo_federation" -> Right Server.Types.EFApolloFederation
|
"apollo_federation" -> Right Server.Types.EFApolloFederation
|
||||||
"hide_update_many_fields" -> Right Server.Types.EFHideUpdateManyFields
|
"hide_update_many_fields" -> Right Server.Types.EFHideUpdateManyFields
|
||||||
|
"bigquery_string_numeric_input" -> Right Server.Types.EFBigQueryStringNumericInput
|
||||||
_ ->
|
_ ->
|
||||||
Left $
|
Left $
|
||||||
"Only expecting list of comma separated experimental features, options are:"
|
"Only expecting list of comma separated experimental features, options are:"
|
||||||
++ "inherited_roles, streaming_subscriptions, hide_update_many_fields, optimize_permission_filters, naming_convention, apollo_federation"
|
++ "inherited_roles, streaming_subscriptions, hide_update_many_fields, optimize_permission_filters, naming_convention, apollo_federation, bigquery_string_numeric_input"
|
||||||
|
|
||||||
instance FromEnv Subscription.Options.BatchSize where
|
instance FromEnv Subscription.Options.BatchSize where
|
||||||
fromEnv s = do
|
fromEnv s = do
|
||||||
|
@ -76,6 +76,7 @@ data ExperimentalFeature
|
|||||||
| EFStreamingSubscriptions
|
| EFStreamingSubscriptions
|
||||||
| EFApolloFederation
|
| EFApolloFederation
|
||||||
| EFHideUpdateManyFields
|
| EFHideUpdateManyFields
|
||||||
|
| EFBigQueryStringNumericInput
|
||||||
deriving (Show, Eq, Generic)
|
deriving (Show, Eq, Generic)
|
||||||
|
|
||||||
instance Hashable ExperimentalFeature
|
instance Hashable ExperimentalFeature
|
||||||
@ -88,7 +89,8 @@ instance FromJSON ExperimentalFeature where
|
|||||||
"streaming_subscriptions" -> pure EFStreamingSubscriptions
|
"streaming_subscriptions" -> pure EFStreamingSubscriptions
|
||||||
"hide_update_many_fields" -> pure EFHideUpdateManyFields
|
"hide_update_many_fields" -> pure EFHideUpdateManyFields
|
||||||
"apollo_federation" -> pure EFApolloFederation
|
"apollo_federation" -> pure EFApolloFederation
|
||||||
_ -> fail "ExperimentalFeature can only be one of these value: inherited_roles, optimize_permission_filters, hide_update_many_fields, naming_convention, streaming_subscriptions or apollo_federation"
|
"bigquery_string_numeric_input" -> pure EFBigQueryStringNumericInput
|
||||||
|
_ -> fail "ExperimentalFeature can only be one of these value: inherited_roles, optimize_permission_filters, hide_update_many_fields, naming_convention, streaming_subscriptions apollo_federation, or bigquery_string_numeric_input"
|
||||||
|
|
||||||
instance ToJSON ExperimentalFeature where
|
instance ToJSON ExperimentalFeature where
|
||||||
toJSON = \case
|
toJSON = \case
|
||||||
@ -98,6 +100,7 @@ instance ToJSON ExperimentalFeature where
|
|||||||
EFStreamingSubscriptions -> "streaming_subscriptions"
|
EFStreamingSubscriptions -> "streaming_subscriptions"
|
||||||
EFApolloFederation -> "apollo_federation"
|
EFApolloFederation -> "apollo_federation"
|
||||||
EFHideUpdateManyFields -> "hide_update_many_fields"
|
EFHideUpdateManyFields -> "hide_update_many_fields"
|
||||||
|
EFBigQueryStringNumericInput -> "bigquery_string_numeric_input"
|
||||||
|
|
||||||
data MaintenanceMode a = MaintenanceModeEnabled a | MaintenanceModeDisabled
|
data MaintenanceMode a = MaintenanceModeEnabled a | MaintenanceModeDisabled
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
@ -119,7 +119,12 @@ buildPostgresSpecs = do
|
|||||||
|
|
||||||
setupCacheRef = do
|
setupCacheRef = do
|
||||||
httpManager <- HTTP.newManager HTTP.tlsManagerSettings
|
httpManager <- HTTP.newManager HTTP.tlsManagerSettings
|
||||||
let sqlGenCtx = SQLGenCtx Options.Don'tStringifyNumbers Options.Don'tDangerouslyCollapseBooleans Options.Don'tOptimizePermissionFilters
|
let sqlGenCtx =
|
||||||
|
SQLGenCtx
|
||||||
|
Options.Don'tStringifyNumbers
|
||||||
|
Options.Don'tDangerouslyCollapseBooleans
|
||||||
|
Options.Don'tOptimizePermissionFilters
|
||||||
|
Options.EnableBigQueryStringNumericInput
|
||||||
maintenanceMode = MaintenanceModeDisabled
|
maintenanceMode = MaintenanceModeDisabled
|
||||||
readOnlyMode = ReadOnlyModeDisabled
|
readOnlyMode = ReadOnlyModeDisabled
|
||||||
serverConfigCtx =
|
serverConfigCtx =
|
||||||
|
@ -71,7 +71,8 @@ instance Has SchemaOptions SchemaEnvironment where
|
|||||||
soDangerousBooleanCollapse = Options.Don'tDangerouslyCollapseBooleans,
|
soDangerousBooleanCollapse = Options.Don'tDangerouslyCollapseBooleans,
|
||||||
soInferFunctionPermissions = Options.InferFunctionPermissions,
|
soInferFunctionPermissions = Options.InferFunctionPermissions,
|
||||||
soOptimizePermissionFilters = Options.Don'tOptimizePermissionFilters,
|
soOptimizePermissionFilters = Options.Don'tOptimizePermissionFilters,
|
||||||
soIncludeUpdateManyFields = Options.IncludeUpdateManyFields
|
soIncludeUpdateManyFields = Options.IncludeUpdateManyFields,
|
||||||
|
soBigQueryStringNumericInput = Options.EnableBigQueryStringNumericInput
|
||||||
}
|
}
|
||||||
|
|
||||||
modifier :: (SchemaOptions -> SchemaOptions) -> SchemaEnvironment -> SchemaEnvironment
|
modifier :: (SchemaOptions -> SchemaOptions) -> SchemaEnvironment -> SchemaEnvironment
|
||||||
|
@ -60,7 +60,7 @@ import Hasura.Server.Init qualified as Init
|
|||||||
import Hasura.Server.Logging (MetadataQueryLoggingMode (MetadataQueryLoggingDisabled))
|
import Hasura.Server.Logging (MetadataQueryLoggingMode (MetadataQueryLoggingDisabled))
|
||||||
import Hasura.Server.Types
|
import Hasura.Server.Types
|
||||||
( EventingMode (EventingEnabled),
|
( EventingMode (EventingEnabled),
|
||||||
ExperimentalFeature (EFStreamingSubscriptions),
|
ExperimentalFeature (..),
|
||||||
MaintenanceMode (MaintenanceModeDisabled),
|
MaintenanceMode (MaintenanceModeDisabled),
|
||||||
ReadOnlyMode (ReadOnlyModeDisabled),
|
ReadOnlyMode (ReadOnlyModeDisabled),
|
||||||
)
|
)
|
||||||
@ -271,7 +271,7 @@ serveOptions =
|
|||||||
soEnableMaintenanceMode = MaintenanceModeDisabled,
|
soEnableMaintenanceMode = MaintenanceModeDisabled,
|
||||||
-- MUST be disabled to be able to modify schema.
|
-- MUST be disabled to be able to modify schema.
|
||||||
soSchemaPollInterval = Interval $$(refineTH 10),
|
soSchemaPollInterval = Interval $$(refineTH 10),
|
||||||
soExperimentalFeatures = Set.singleton EFStreamingSubscriptions,
|
soExperimentalFeatures = Set.fromList [EFStreamingSubscriptions, EFBigQueryStringNumericInput],
|
||||||
soEventsFetchBatchSize = $$(refineTH 1),
|
soEventsFetchBatchSize = $$(refineTH 1),
|
||||||
soDevMode = True,
|
soDevMode = True,
|
||||||
soGracefulShutdownTimeout = $$(refineTH 0), -- Don't wait to shutdown.
|
soGracefulShutdownTimeout = $$(refineTH 0), -- Don't wait to shutdown.
|
||||||
|
@ -183,6 +183,43 @@ tests opts = do
|
|||||||
|
|
||||||
actual `shouldBe` expected
|
actual `shouldBe` expected
|
||||||
|
|
||||||
|
it "Accepts strings for numbers in input fields (experimental feature 'bigquery_string_numeric_input')" \testEnvironment -> do
|
||||||
|
let schemaName = Schema.getSchemaName testEnvironment
|
||||||
|
|
||||||
|
let expected :: Value
|
||||||
|
expected =
|
||||||
|
[interpolateYaml|
|
||||||
|
data:
|
||||||
|
#{schemaName}_all_types:
|
||||||
|
- float: "0.5"
|
||||||
|
numeric: "1234"
|
||||||
|
bignumeric: "23456789098765432"
|
||||||
|
|]
|
||||||
|
|
||||||
|
actual :: IO Value
|
||||||
|
actual =
|
||||||
|
postGraphql
|
||||||
|
testEnvironment
|
||||||
|
[graphql|
|
||||||
|
query {
|
||||||
|
#{schemaName}_all_types(where:
|
||||||
|
{_and: [
|
||||||
|
{ float: { _eq: "0.5" }}
|
||||||
|
{ integer: { _eq: "3" }}
|
||||||
|
{ numeric: { _eq: "1234" }}
|
||||||
|
{ bignumeric: { _eq: "23456789098765432" }}
|
||||||
|
]
|
||||||
|
}
|
||||||
|
) {
|
||||||
|
float
|
||||||
|
numeric
|
||||||
|
bignumeric
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
actual `shouldBe` expected
|
||||||
|
|
||||||
it "Aggregates all comparable types" \testEnvironment -> do
|
it "Aggregates all comparable types" \testEnvironment -> do
|
||||||
let schemaName = Schema.getSchemaName testEnvironment
|
let schemaName = Schema.getSchemaName testEnvironment
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user