From 63f06ffe8f12c2f10e5ce0bd3a2e377d540c4f2c Mon Sep 17 00:00:00 2001 From: Nizar Malangadan Date: Wed, 20 Feb 2019 17:09:04 +0530 Subject: [PATCH 01/13] Make PGColType extract info for arrays, domains, range etc --- server/graphql-engine.cabal | 1 + server/src-lib/Hasura/GraphQL/Context.hs | 79 ++-- server/src-lib/Hasura/GraphQL/RemoteServer.hs | 2 +- .../src-lib/Hasura/GraphQL/Resolve/BoolExp.hs | 9 +- .../Hasura/GraphQL/Resolve/InputValue.hs | 11 +- .../src-lib/Hasura/GraphQL/Resolve/Insert.hs | 6 +- .../Hasura/GraphQL/Resolve/Introspect.hs | 13 +- .../Hasura/GraphQL/Resolve/Mutation.hs | 16 +- .../src-lib/Hasura/GraphQL/Resolve/Select.hs | 5 +- server/src-lib/Hasura/GraphQL/Schema.hs | 145 +++---- server/src-lib/Hasura/GraphQL/Utils.hs | 6 + server/src-lib/Hasura/GraphQL/Validate.hs | 27 +- .../Hasura/GraphQL/Validate/Context.hs | 6 +- .../src-lib/Hasura/GraphQL/Validate/Field.hs | 13 +- .../Hasura/GraphQL/Validate/InputValue.hs | 54 +-- .../src-lib/Hasura/GraphQL/Validate/Types.hs | 151 +++++--- .../Hasura/RQL/DDL/Permission/Internal.hs | 7 +- .../src-lib/Hasura/RQL/DDL/Schema/PGType.hs | 93 +++++ server/src-lib/Hasura/RQL/DDL/Schema/Table.hs | 31 +- server/src-lib/Hasura/RQL/DML/Internal.hs | 12 +- server/src-lib/Hasura/RQL/DML/Select.hs | 5 +- server/src-lib/Hasura/RQL/GBoolExp.hs | 38 +- server/src-lib/Hasura/RQL/Instances.hs | 27 ++ server/src-lib/Hasura/RQL/Types/Common.hs | 89 +++++ .../src-lib/Hasura/RQL/Types/SchemaCache.hs | 15 +- server/src-lib/Hasura/SQL/DML.hs | 21 +- server/src-lib/Hasura/SQL/Types.hs | 211 +++++++--- server/src-lib/Hasura/SQL/Value.hs | 359 +++++++++++++----- server/src-rsr/pg_type_info.sql | 70 ++++ server/src-rsr/table_info.sql | 44 ++- server/stack.yaml | 4 +- 31 files changed, 1151 insertions(+), 419 deletions(-) create mode 100644 server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs create mode 100644 server/src-rsr/pg_type_info.sql diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 77deaab336a73..034cb0aee5261 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -167,6 +167,7 @@ library , Hasura.RQL.DDL.Relationship , Hasura.RQL.DDL.QueryTemplate , Hasura.RQL.DDL.Schema.Table + , Hasura.RQL.DDL.Schema.PGType , Hasura.RQL.DDL.Schema.Function , Hasura.RQL.DDL.Schema.Diff , Hasura.RQL.DDL.Metadata diff --git a/server/src-lib/Hasura/GraphQL/Context.hs b/server/src-lib/Hasura/GraphQL/Context.hs index 11ff45fed6804..a1dc298d82529 100644 --- a/server/src-lib/Hasura/GraphQL/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Context.hs @@ -38,6 +38,7 @@ data OpCtx | OCDelete QualifiedTable AnnBoolExpSQL [T.Text] deriving (Show, Eq) + data GCtx = GCtx { _gTypes :: !TypeMap @@ -125,10 +126,11 @@ mkHsraObjFldInfo :: Maybe G.Description -> G.Name -> ParamMap + -> Maybe PGColType -> G.GType -> ObjFldInfo -mkHsraObjFldInfo descM name params ty = - ObjFldInfo descM name params ty HasuraType +mkHsraObjFldInfo descM name params pgTy ty = + ObjFldInfo descM name params pgTy ty HasuraType mkHsraObjTyInfo :: Maybe G.Description @@ -156,14 +158,14 @@ mkHsraEnumTyInfo descM ty enumVals = EnumTyInfo descM ty enumVals HasuraType mkHsraScalarTyInfo :: PGColType -> ScalarTyInfo -mkHsraScalarTyInfo ty = ScalarTyInfo Nothing ty HasuraType +mkHsraScalarTyInfo ty = ScalarTyInfo Nothing (G.Name $ pgColTyToScalar ty) HasuraType fromInpValL :: [InpValInfo] -> Map.HashMap G.Name InpValInfo fromInpValL = mapFromL _iviName mkCompExpName :: PGColType -> G.Name mkCompExpName pgColTy = - G.Name $ T.pack (show pgColTy) <> "_comparison_exp" + G.Name $ pgColTyToScalar pgColTy <> "_comparison_exp" mkCompExpTy :: PGColType -> G.NamedType mkCompExpTy = @@ -181,15 +183,17 @@ stDWithinInpTy = G.NamedType "st_d_within_input" --- | make compare expression input type +-- TODO Nizar, how does _in comparison work with arrays mkCompExpInp :: PGColType -> InpObjTyInfo -mkCompExpInp colTy = +mkCompExpInp colTy@(PGColType _ _ _ colDtls) = InpObjTyInfo (Just tyDesc) (mkCompExpTy colTy) (fromInpValL $ concat - [ map (mk colScalarTy) typedOps - , map (mk $ G.toLT colScalarTy) listOps - , bool [] (map (mk $ mkScalarTy PGText) stringOps) isStringTy + [ map (mk (Just colTy) colGQLTy) typedOps + -- TODO Nizar: Fix me , use an array of PGCol type here + , map (mk Nothing $ G.toLT colGQLTy) listOps + , bool [] (map (mk (Just $ baseBuiltInTy PGText) $ mkScalarBaseTy PGText) stringOps) isStringTy , bool [] (map jsonbOpToInpVal jsonbOps) isJsonbTy , bool [] (stDWithinOpInpVal : map geomOpToInpVal geomOps) isGeometryTy - , [InpValInfo Nothing "_is_null" Nothing $ G.TypeNamed (G.Nullability True) $ G.NamedType "Boolean"] + , [InpValInfo Nothing "_is_null" Nothing (Just $ baseBuiltInTy PGBoolean) $ G.TypeNamed (G.Nullability True) $ G.NamedType "Boolean"] ]) HasuraType where tyDesc = mconcat @@ -197,12 +201,15 @@ mkCompExpInp colTy = , G.Description (T.pack $ show colTy) , ". All fields are combined with logical 'AND'." ] - isStringTy = case colTy of - PGVarchar -> True - PGText -> True - _ -> False - mk t n = InpValInfo Nothing n Nothing $ G.toGT t - colScalarTy = mkScalarTy colTy + baseTy = case colDtls of + PGTyBase b -> return b + _ -> Nothing + isStringTy = case baseTy of + Just PGVarchar -> True + Just PGText -> True + _ -> False + mk pt t n = InpValInfo Nothing n Nothing pt $ G.toGT t + colGQLTy = mkPGColGTy colTy -- colScalarListTy = GA.GTList colGTy typedOps = ["_eq", "_neq", "_gt", "_lt", "_gte", "_lte"] @@ -216,45 +223,45 @@ mkCompExpInp colTy = , "_similar", "_nsimilar" ] - isJsonbTy = case colTy of - PGJSONB -> True - _ -> False - jsonbOpToInpVal (op, ty, desc) = InpValInfo (Just desc) op Nothing ty + isJsonbTy = case baseTy of + Just PGJSONB -> True + _ -> False + jsonbOpToInpVal (op, ty, desc) = InpValInfo (Just desc) op Nothing (Just $ baseBuiltInTy PGJSONB) ty jsonbOps = [ ( "_contains" - , G.toGT $ mkScalarTy PGJSONB + , G.toGT $ mkScalarBaseTy PGJSONB , "does the column contain the given json value at the top level" ) , ( "_contained_in" - , G.toGT $ mkScalarTy PGJSONB + , G.toGT $ mkScalarBaseTy PGJSONB , "is the column contained in the given json value" ) , ( "_has_key" - , G.toGT $ mkScalarTy PGText + , G.toGT $ mkScalarBaseTy PGText , "does the string exist as a top-level key in the column" ) , ( "_has_keys_any" - , G.toGT $ G.toLT $ G.toNT $ mkScalarTy PGText + , G.toGT $ G.toLT $ G.toNT $ mkScalarBaseTy PGText , "do any of these strings exist as top-level keys in the column" ) , ( "_has_keys_all" - , G.toGT $ G.toLT $ G.toNT $ mkScalarTy PGText + , G.toGT $ G.toLT $ G.toNT $ mkScalarBaseTy PGText , "do all of these strings exist as top-level keys in the column" ) ] -- Geometry related ops stDWithinOpInpVal = - InpValInfo (Just stDWithinDesc) "_st_d_within" Nothing $ G.toGT stDWithinInpTy + InpValInfo (Just stDWithinDesc) "_st_d_within" Nothing (Just $ baseBuiltInTy PGGeometry) $ G.toGT stDWithinInpTy stDWithinDesc = "is the column within a distance from a geometry value" - isGeometryTy = case colTy of - PGGeometry -> True - _ -> False + isGeometryTy = case baseTy of + Just PGGeometry -> True + _ -> False geomOpToInpVal (op, desc) = - InpValInfo (Just desc) op Nothing $ G.toGT $ mkScalarTy PGGeometry + InpValInfo (Just desc) op Nothing (Just $ baseBuiltInTy PGGeometry) $ G.toGT $ mkScalarBaseTy PGGeometry geomOps = [ ( "_st_contains" @@ -313,7 +320,7 @@ ordByEnumTy = ] defaultTypes :: [TypeInfo] -defaultTypes = $(fromSchemaDocQ defaultSchema HasuraType) +defaultTypes = $(fromSchemaDocQ defaultSchema defaultPGColTyMap HasuraType) mkGCtx :: TyAgg -> RootFlds -> InsCtxMap -> GCtx @@ -347,21 +354,21 @@ mkGCtx (TyAgg tyInfos fldInfos ordByEnums funcArgCtx) (RootFlds flds) insCtxMap (G.NamedType "subscription_root") Set.empty . mapFromL _fiName subRootM = bool (Just $ mkSubRoot qFlds) Nothing $ null qFlds (qFlds, mFlds) = partitionEithers $ map snd $ Map.elems flds - schemaFld = mkHsraObjFldInfo Nothing "__schema" Map.empty $ + schemaFld = mkHsraObjFldInfo Nothing "__schema" Map.empty Nothing $ G.toGT $ G.toNT $ G.NamedType "__Schema" - typeFld = mkHsraObjFldInfo Nothing "__type" typeFldArgs $ + typeFld = mkHsraObjFldInfo Nothing "__type" typeFldArgs Nothing $ G.toGT $ G.NamedType "__Type" where typeFldArgs = mapFromL _iviName [ - InpValInfo (Just "name of the type") "name" Nothing + InpValInfo (Just "name of the type") "name" Nothing Nothing $ G.toGT $ G.toNT $ G.NamedType "String" ] - stDWithinInpM = bool Nothing (Just stDWithinInp) (PGGeometry `elem` colTys) + stDWithinInpM = bool Nothing (Just stDWithinInp) (PGTyBase PGGeometry `elem` map pgColTyDetails colTys) stDWithinInp = mkHsraInpTyInfo Nothing stDWithinInpTy $ fromInpValL - [ InpValInfo Nothing "from" Nothing $ G.toGT $ G.toNT $ mkScalarTy PGGeometry - , InpValInfo Nothing "distance" Nothing $ G.toNT $ G.toNT $ mkScalarTy PGFloat + [ InpValInfo Nothing "from" Nothing (Just $ baseBuiltInTy PGGeometry) $ G.toGT $ G.toNT $ mkScalarBaseTy PGGeometry + , InpValInfo Nothing "distance" Nothing (Just $ baseBuiltInTy PGGeometry) $ G.toNT $ G.toNT $ mkScalarBaseTy PGFloat ] emptyGCtx :: GCtx diff --git a/server/src-lib/Hasura/GraphQL/RemoteServer.hs b/server/src-lib/Hasura/GraphQL/RemoteServer.hs index 4a73e4e3c82c5..1ccdd0ed7d37b 100644 --- a/server/src-lib/Hasura/GraphQL/RemoteServer.hs +++ b/server/src-lib/Hasura/GraphQL/RemoteServer.hs @@ -52,7 +52,7 @@ fetchRemoteSchema manager name def@(RemoteSchemaInfo url headerConf _) = do either schemaErr return $ J.eitherDecode respData let (sDoc, qRootN, mRootN, sRootN) = fromIntrospection introspectRes - typMap <- either remoteSchemaErr return $ VT.fromSchemaDoc sDoc $ + typMap <- either remoteSchemaErr return $ VT.fromSchemaDoc sDoc Map.empty $ VT.RemoteType name def let mQrTyp = Map.lookup qRootN typMap mMrTyp = maybe Nothing (\mr -> Map.lookup mr typMap) mRootN diff --git a/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs b/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs index c307cd37d7322..b5149265eaedc 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PatternSynonyms #-} module Hasura.GraphQL.Resolve.BoolExp ( parseBoolExp , pgColValToBoolExp @@ -20,6 +21,8 @@ import Hasura.SQL.Value type OpExp = OpExpG (PGColType, PGColValue) +pattern PGBoolVal o b = PGColValue o (PGValBase (PGValKnown (PGValBoolean b))) + parseOpExps :: (MonadError QErr m) => AnnGValue -> m [OpExp] @@ -74,10 +77,10 @@ parseOpExps annVal = do return $ catMaybes $ fromMaybe [] opExpsM where resolveIsNull v = case v of - AGScalar _ Nothing -> return Nothing - AGScalar _ (Just (PGValBoolean b)) -> + AGPGVal _ Nothing -> return Nothing + AGPGVal _ (Just (PGBoolVal _ b)) -> return $ Just $ bool ANISNOTNULL ANISNULL b - AGScalar _ _ -> throw500 "boolean value is expected" + AGPGVal _ _ -> throw500 "boolean value is expected" _ -> tyMismatch "pgvalue" v parseAsSTDWithinObj obj = do diff --git a/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs b/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs index 3e661301c8405..054e6d17195e3 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PatternSynonyms #-} module Hasura.GraphQL.Resolve.InputValue ( withNotNull , tyMismatch @@ -44,15 +45,15 @@ asPGColValM :: (MonadError QErr m) => AnnGValue -> m (Maybe (PGColType, PGColValue)) asPGColValM = \case - AGScalar colTy valM -> return $ fmap (colTy,) valM + AGPGVal colTy valM -> return $ fmap (colTy,) valM v -> tyMismatch "pgvalue" v asPGColVal :: (MonadError QErr m) => AnnGValue -> m (PGColType, PGColValue) asPGColVal = \case - AGScalar colTy (Just val) -> return (colTy, val) - AGScalar colTy Nothing -> + AGPGVal colTy (Just val) -> return (colTy, val) + AGPGVal colTy Nothing -> throw500 $ "unexpected null for ty " <> T.pack (show colTy) v -> tyMismatch "pgvalue" v @@ -121,11 +122,13 @@ parseMany fn v = case v of AGArray _ arrM -> mapM (mapM fn) arrM _ -> tyMismatch "array" v +pattern PGTxtVal o x = PGColValue o (PGValBase (PGValKnown (PGValText x))) + asPGColText :: (MonadError QErr m) => AnnGValue -> m Text asPGColText val = do (_, pgColVal) <- asPGColVal val case pgColVal of - PGValText t -> return t + (PGTxtVal _ t) -> return t _ -> throw500 "expecting text for asPGColText" diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs index 808f8c46908e6..16a00a0fd8837 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -96,11 +96,11 @@ traverseInsObj -> m AnnInsObj traverseInsObj rim (gName, annVal) defVal@(AnnInsObj cols objRels arrRels) = case annVal of - AGScalar colty mColVal -> do + AGPGVal colty mColVal -> do let col = PGCol $ G.unName gName - colVal = fromMaybe (PGNull colty) mColVal + colVal = fromMaybe (PGColValue (pgColTyOid colty) PGNull) mColVal return (AnnInsObj ((col, colty, colVal):cols) objRels arrRels) - + --AGArray (G.ListType g) mVal -> _ -> do objM <- asObjectM annVal -- if relational insert input is 'null' then ignore diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs b/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs index b42a930bb0609..4ae911d311539 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PatternSynonyms #-} module Hasura.GraphQL.Resolve.Introspect ( schemaR , typeR @@ -60,13 +61,13 @@ scalarR => ScalarTyInfo -> Field -> m J.Object -scalarR (ScalarTyInfo descM pgColType _) fld = +scalarR (ScalarTyInfo descM name _) fld = withSubFields (_fSelSet fld) $ \subFld -> case _fName subFld of "__typename" -> retJT "__Type" "kind" -> retJ TKSCALAR "description" -> retJ $ fmap G.unDescription descM - "name" -> retJ $ pgColTyToScalar pgColType + "name" -> retJ $ G.unName name _ -> return J.Null -- 4.5.2.2 @@ -237,7 +238,7 @@ fieldR :: ( MonadReader r m, Has TypeMap r , MonadError QErr m) => ObjFldInfo -> Field -> m J.Object -fieldR (ObjFldInfo descM n params ty _) fld = +fieldR (ObjFldInfo descM n params _ ty _) fld = withSubFields (_fSelSet fld) $ \subFld -> case _fName subFld of "__typename" -> retJT "__Field" @@ -254,7 +255,7 @@ inputValueR :: ( MonadReader r m, Has TypeMap r , MonadError QErr m) => Field -> InpValInfo -> m J.Object -inputValueR fld (InpValInfo descM n defM ty) = +inputValueR fld (InpValInfo descM n defM _ ty) = withSubFields (_fSelSet fld) $ \subFld -> case _fName subFld of "__typename" -> retJT "__InputValue" @@ -328,6 +329,8 @@ schemaR fld = (sortBy (comparing _diName) defaultDirectives) _ -> return J.Null +pattern PGTxtVal o t = PGColValue o (PGValBase (PGValKnown (PGValText t))) + typeR :: ( MonadReader r m, Has TypeMap r , MonadError QErr m) @@ -336,7 +339,7 @@ typeR fld = do name <- withArg args "name" $ \arg -> do (_, pgColVal) <- asPGColVal arg case pgColVal of - PGValText t -> return t + PGTxtVal _ t -> return t _ -> throw500 "expecting string for name arg of __type" typeR' (G.Name name) fld where diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index fd15b368a8467..edbd7bbeb87b9 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -51,13 +51,13 @@ convertRowObj val = type ApplySQLOp = (PGCol, S.SQLExp) -> S.SQLExp -rhsExpOp :: S.SQLOp -> S.AnnType -> ApplySQLOp +rhsExpOp :: S.SQLOp -> AnnType -> ApplySQLOp rhsExpOp op annTy (col, e) = S.mkSQLOpExp op (S.SEIden $ toIden col) annExp where annExp = S.SETyAnn e annTy -lhsExpOp :: S.SQLOp -> S.AnnType -> ApplySQLOp +lhsExpOp :: S.SQLOp -> AnnType -> ApplySQLOp lhsExpOp op annTy (col, e) = S.mkSQLOpExp op annExp $ S.SEIden $ toIden col where @@ -82,7 +82,7 @@ convDeleteAtPathObj val = vals <- flip withArray v $ \_ annVals -> mapM asPGColVal annVals let valExps = map (txtEncoder . snd) vals pgCol = PGCol $ G.unName k - annEncVal = S.SETyAnn (S.SEArray valExps) S.textArrType + annEncVal = S.SETyAnn (S.SEArray valExps) textArrType sqlExp = S.SEOpApp S.jsonbDeleteAtPathOp [S.SEIden $ toIden pgCol, annEncVal] return (pgCol, sqlExp) @@ -99,19 +99,19 @@ convertUpdate tn filterExp fld = do whereExp <- withArg args "where" (parseBoolExp prepare) -- increment operator on integer columns incExpM <- withArgM args "_inc" $ - convObjWithOp $ rhsExpOp S.incOp S.intType + convObjWithOp $ rhsExpOp S.incOp intType -- append jsonb value appendExpM <- withArgM args "_append" $ - convObjWithOp $ rhsExpOp S.jsonbConcatOp S.jsonbType + convObjWithOp $ rhsExpOp S.jsonbConcatOp jsonbType -- prepend jsonb value prependExpM <- withArgM args "_prepend" $ - convObjWithOp $ lhsExpOp S.jsonbConcatOp S.jsonbType + convObjWithOp $ lhsExpOp S.jsonbConcatOp jsonbType -- delete a key in jsonb object deleteKeyExpM <- withArgM args "_delete_key" $ - convObjWithOp $ rhsExpOp S.jsonbDeleteOp S.textType + convObjWithOp $ rhsExpOp S.jsonbDeleteOp textType -- delete an element in jsonb array deleteElemExpM <- withArgM args "_delete_elem" $ - convObjWithOp $ rhsExpOp S.jsonbDeleteOp S.intType + convObjWithOp $ rhsExpOp S.jsonbDeleteOp intType -- delete at path in jsonb value deleteAtPathExpM <- withArgM args "_delete_at_path" convDeleteAtPathObj diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs index 6a7ec2f1b0b0a..40f2a3c86ad73 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PatternSynonyms #-} module Hasura.GraphQL.Resolve.Select ( convertSelect , convertSelectByPKey @@ -264,6 +265,8 @@ parseColumns val = (_, enumVal) <- asEnumVal v return $ PGCol $ G.unName $ G.unEnumValue enumVal +pattern PGBoolVal o b = PGColValue o (PGValBase (PGValKnown (PGValBoolean b))) + convertCount :: MonadError QErr m => ArgsMap -> m S.CountType convertCount args = do columnsM <- withArgM args "columns" parseColumns @@ -273,7 +276,7 @@ convertCount args = do parseDistinct v = do (_, val) <- asPGColVal v case val of - PGValBoolean b -> return b + PGBoolVal _ b -> return b _ -> throw500 "expecting Boolean for \"distinct\"" diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index 34b286142b396..2ff7d718cc922 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -334,7 +334,7 @@ mkTableByPKeyTy tn = qualObjectToName tn <> "_by_pk" mkPGColFld :: PGColInfo -> ObjFldInfo mkPGColFld (PGColInfo colName colTy isNullable) = - mkHsraObjFldInfo Nothing n Map.empty ty + mkHsraObjFldInfo Nothing n Map.empty (Just colTy) ty where n = G.Name $ getPGColTxt colName ty = bool notNullTy nullTy isNullable @@ -348,12 +348,12 @@ mkPGColFld (PGColInfo colName colTy isNullable) = -- distinct_on: [table_select_column!] mkSelArgs :: QualifiedTable -> [InpValInfo] mkSelArgs tn = - [ InpValInfo (Just whereDesc) "where" Nothing $ G.toGT $ mkBoolExpTy tn - , InpValInfo (Just limitDesc) "limit" Nothing $ G.toGT $ mkScalarTy PGInteger - , InpValInfo (Just offsetDesc) "offset" Nothing $ G.toGT $ mkScalarTy PGInteger - , InpValInfo (Just orderByDesc) "order_by" Nothing $ G.toGT $ G.toLT $ G.toNT $ + [ InpValInfo (Just whereDesc) "where" Nothing Nothing $ G.toGT $ mkBoolExpTy tn + , InpValInfo (Just limitDesc) "limit" Nothing Nothing $ G.toGT $ mkScalarBaseTy PGInteger + , InpValInfo (Just offsetDesc) "offset" Nothing Nothing $ G.toGT $ mkScalarBaseTy PGInteger + , InpValInfo (Just orderByDesc) "order_by" Nothing Nothing $ G.toGT $ G.toLT $ G.toNT $ mkOrdByTy tn - , InpValInfo (Just distinctDesc) "distinct_on" Nothing $ G.toGT $ G.toLT $ + , InpValInfo (Just distinctDesc) "distinct_on" Nothing Nothing $ G.toGT $ G.toLT $ G.toNT $ mkSelColumnInpTy tn ] where @@ -391,17 +391,17 @@ mkRelFld allowAgg (RelInfo rn rTy _ remTab isManual) isNullable = case rTy of ObjRel -> [objRelFld] where objRelFld = mkHsraObjFldInfo (Just "An object relationship") - (G.Name $ getRelTxt rn) Map.empty objRelTy + (G.Name $ getRelTxt rn) Map.empty Nothing objRelTy objRelTy = bool (G.toGT $ G.toNT relTabTy) (G.toGT relTabTy) isObjRelNullable isObjRelNullable = isManual || isNullable relTabTy = mkTableTy remTab arrRelFld = mkHsraObjFldInfo (Just "An array relationship") (G.Name $ getRelTxt rn) - (fromInpValL $ mkSelArgs remTab) arrRelTy + (fromInpValL $ mkSelArgs remTab) Nothing arrRelTy arrRelTy = G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkTableTy remTab aggArrRelFld = mkHsraObjFldInfo (Just "An aggregated array relationship") - (mkAggRelName rn) (fromInpValL $ mkSelArgs remTab) $ + (mkAggRelName rn) (fromInpValL $ mkSelArgs remTab) Nothing $ G.toGT $ G.toNT $ mkTableAggTy remTab {- @@ -439,9 +439,9 @@ mkTableAggObj tn = desc = G.Description $ "aggregated selection of " <>> tn - aggFld = mkHsraObjFldInfo Nothing "aggregate" Map.empty $ G.toGT $ + aggFld = mkHsraObjFldInfo Nothing "aggregate" Map.empty Nothing $ G.toGT $ mkTableAggFldsTy tn - nodesFld = mkHsraObjFldInfo Nothing "nodes" Map.empty $ G.toGT $ + nodesFld = mkHsraObjFldInfo Nothing "nodes" Map.empty Nothing $ G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkTableTy tn {- @@ -466,20 +466,18 @@ mkTableAggFldsObj tn numCols compCols = desc = G.Description $ "aggregate fields of " <>> tn - countFld = mkHsraObjFldInfo Nothing "count" countParams $ G.toGT $ - mkScalarTy PGInteger + countFld = mkHsraObjFldInfo Nothing "count" countParams (Just $ baseBuiltInTy PGInteger) $ G.toGT $ mkScalarBaseTy PGInteger countParams = fromInpValL [countColInpVal, distinctInpVal] - countColInpVal = InpValInfo Nothing "columns" Nothing $ G.toGT $ + countColInpVal = InpValInfo Nothing "columns" Nothing Nothing $ G.toGT $ G.toLT $ G.toNT $ mkSelColumnInpTy tn - distinctInpVal = InpValInfo Nothing "distinct" Nothing $ G.toGT $ - mkScalarTy PGBoolean + distinctInpVal = InpValInfo Nothing "distinct" Nothing (Just $ baseBuiltInTy PGBoolean) $ G.toGT $ mkScalarBaseTy PGBoolean numFlds = bool (map mkColOpFld numAggOps) [] $ null numCols compFlds = bool (map mkColOpFld compAggOps) [] $ null compCols - mkColOpFld op = mkHsraObjFldInfo Nothing op Map.empty $ G.toGT $ + mkColOpFld op = mkHsraObjFldInfo Nothing op Map.empty Nothing $ G.toGT $ mkTableColAggFldsTy op tn {- @@ -501,8 +499,9 @@ mkTableColAggFldsObj tn op f cols = where desc = G.Description $ "aggregate " <> G.unName op <> " on columns" - mkColObjFld c = mkHsraObjFldInfo Nothing (G.Name $ getPGColTxt $ pgiName c) - Map.empty $ G.toGT $ f $ pgiType c + mkColObjFld c = let colTy = pgiType c in + mkHsraObjFldInfo Nothing (G.Name $ getPGColTxt $ pgiName c) + Map.empty (Just colTy) $ G.toGT $ f colTy {- @@ -517,7 +516,7 @@ mkSelFld :: QualifiedTable -> ObjFldInfo mkSelFld tn = - mkHsraObjFldInfo (Just desc) fldName args ty + mkHsraObjFldInfo (Just desc) fldName args Nothing ty where desc = G.Description $ "fetch data from the table: " <>> tn fldName = qualObjectToName tn @@ -536,7 +535,7 @@ mkSelFldPKey :: QualifiedTable -> [PGColInfo] -> ObjFldInfo mkSelFldPKey tn cols = - mkHsraObjFldInfo (Just desc) fldName args ty + mkHsraObjFldInfo (Just desc) fldName args Nothing ty where desc = G.Description $ "fetch data from the table: " <> tn <<> " using primary key columns" @@ -544,7 +543,7 @@ mkSelFldPKey tn cols = args = fromInpValL $ map colInpVal cols ty = G.toGT $ mkTableTy tn colInpVal (PGColInfo n typ _) = - InpValInfo Nothing (mkColName n) Nothing $ G.toGT $ G.toNT $ mkScalarTy typ + InpValInfo Nothing (mkColName n) Nothing (Just typ) $ G.toGT $ G.toNT $ mkScalarTy typ {- @@ -559,7 +558,7 @@ mkAggSelFld :: QualifiedTable -> ObjFldInfo mkAggSelFld tn = - mkHsraObjFldInfo (Just desc) fldName args ty + mkHsraObjFldInfo (Just desc) fldName args Nothing ty where desc = G.Description $ "fetch aggregated fields from the table: " <>> tn @@ -587,14 +586,14 @@ mkFuncArgs funInfo = retTable = fiReturnType funInfo funcArgDesc = G.Description $ "input parameters for function " <>> funcName - funcInpArg = InpValInfo (Just funcArgDesc) "args" Nothing $ G.toGT $ G.toNT $ + funcInpArg = InpValInfo (Just funcArgDesc) "args" Nothing Nothing $ G.toGT $ G.toNT $ mkFuncArgsTy funcName funcInpArgs = bool [funcInpArg] [] $ null funcArgs mkFuncQueryFld :: FunctionInfo -> ObjFldInfo mkFuncQueryFld funInfo = - mkHsraObjFldInfo (Just desc) fldName (mkFuncArgs funInfo) ty + mkHsraObjFldInfo (Just desc) fldName (mkFuncArgs funInfo) Nothing ty where retTable = fiReturnType funInfo funcName = fiName funInfo @@ -619,7 +618,7 @@ function_aggregate( mkFuncAggQueryFld :: FunctionInfo -> ObjFldInfo mkFuncAggQueryFld funInfo = - mkHsraObjFldInfo (Just desc) fldName (mkFuncArgs funInfo) ty + mkHsraObjFldInfo (Just desc) fldName (mkFuncArgs funInfo) Nothing ty where funcName = fiName funInfo retTable = fiReturnType funInfo @@ -655,12 +654,12 @@ mkMutRespObj tn sel = objDesc = G.Description $ "response of any mutation on the table " <>> tn affectedRowsFld = - mkHsraObjFldInfo (Just desc) "affected_rows" Map.empty $ - G.toGT $ G.toNT $ mkScalarTy PGInteger + mkHsraObjFldInfo (Just desc) "affected_rows" Map.empty (Just $ baseBuiltInTy PGInteger) $ + G.toGT $ G.toNT $ mkScalarBaseTy PGInteger where desc = "number of affected rows by the mutation" returningFld = - mkHsraObjFldInfo (Just desc) "returning" Map.empty $ + mkHsraObjFldInfo (Just desc) "returning" Map.empty Nothing $ G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkTableTy tn where desc = "data of the affected rows by the mutation" @@ -685,26 +684,27 @@ mkBoolExpInp tn fields = -- all the fields of this input object inpValues = combinators <> map mkFldExpInp fields - mk n ty = InpValInfo Nothing n Nothing $ G.toGT ty + mk n pgTy ty = InpValInfo Nothing n Nothing pgTy $ G.toGT ty boolExpListTy = G.toLT boolExpTy combinators = - [ mk "_not" boolExpTy - , mk "_and" boolExpListTy - , mk "_or" boolExpListTy + [ mk "_not" Nothing boolExpTy + , mk "_and" Nothing boolExpListTy + , mk "_or" Nothing boolExpListTy ] mkFldExpInp = \case Left (PGColInfo colName colTy _) -> - mk (mkColName colName) (mkCompExpTy colTy) + mk (mkColName colName) Nothing (mkCompExpTy colTy) Right (RelInfo relName _ _ remTab _, _, _, _, _) -> - mk (G.Name $ getRelTxt relName) (mkBoolExpTy remTab) + mk (G.Name $ getRelTxt relName) Nothing (mkBoolExpTy remTab) mkPGColInp :: PGColInfo -> InpValInfo mkPGColInp (PGColInfo colName colTy _) = - InpValInfo Nothing (G.Name $ getPGColTxt colName) Nothing $ - G.toGT $ mkScalarTy colTy + InpValInfo Nothing (G.Name $ getPGColTxt colName) Nothing (Just colTy) $ + mkPGColGTy colTy + --G.toGT $ mkScalarTy colTy {- input function_args { @@ -732,14 +732,14 @@ mkFuncArgsInp funcInfo = case nameM of Just argName -> let argGName = G.Name $ getFuncArgNameTxt argName - inpVal = InpValInfo Nothing argGName Nothing $ - G.toGT $ G.toNT $ mkScalarTy ty + inpVal = InpValInfo Nothing argGName Nothing (Just ty) $ + G.toGT $ G.toNT $ mkPGColGTy ty argCtxItem = FuncArgItem argGName in (items <> pure (inpVal, argCtxItem), argNo) Nothing -> let argGName = G.Name $ "arg_" <> T.pack (show argNo) - inpVal = InpValInfo Nothing argGName Nothing $ - G.toGT $ G.toNT $ mkScalarTy ty + inpVal = InpValInfo Nothing argGName Nothing (Just ty) $ + G.toGT $ G.toNT $ mkPGColGTy ty argCtxItem = FuncArgItem argGName in (items <> pure (inpVal, argCtxItem), argNo + 1) @@ -793,6 +793,7 @@ mkUpdIncInp tn = maybe Nothing mkType -- table__input mkJSONOpTy :: QualifiedTable -> G.Name -> G.NamedType + mkJSONOpTy tn op = G.NamedType $ qualObjectToName tn <> op <> "_input" @@ -889,19 +890,19 @@ mkUpdJSONOpInp tn cols = bool inpObjs [] $ null jsonbCols deleteKeyInpObj = mkHsraInpTyInfo (Just deleteKeyDesc) (mkJSONOpTy tn deleteKeyOp) $ fromInpValL $ map deleteKeyInpVal jsonbColNames - deleteKeyInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing $ + deleteKeyInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ baseBuiltInTy PGText) $ G.toGT $ G.NamedType "String" deleteElemInpObj = mkHsraInpTyInfo (Just deleteElemDesc) (mkJSONOpTy tn deleteElemOp) $ fromInpValL $ map deleteElemInpVal jsonbColNames - deleteElemInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing $ + deleteElemInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ baseBuiltInTy PGInteger) $ G.toGT $ G.NamedType "Int" deleteAtPathInpObj = mkHsraInpTyInfo (Just deleteAtPathDesc) (mkJSONOpTy tn deleteAtPathOp) $ fromInpValL $ map deleteAtPathInpVal jsonbColNames - deleteAtPathInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing $ + deleteAtPathInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ baseBuiltInTy PGText) $ G.toGT $ G.toLT $ G.NamedType "String" {- @@ -924,7 +925,7 @@ mkIncInpVal tn cols = bool (Just incArg) Nothing $ null intCols intCols = onlyIntCols cols incArgDesc = "increments the integer columns with given value of the filtered values" incArg = - InpValInfo (Just incArgDesc) "_inc" Nothing $ G.toGT $ mkUpdIncTy tn + InpValInfo (Just incArgDesc) "_inc" Nothing Nothing $ G.toGT $ mkUpdIncTy tn mkJSONOpInpVals :: QualifiedTable -> [PGColInfo] -> [InpValInfo] mkJSONOpInpVals tn cols = bool jsonbOpArgs [] $ null jsonbCols @@ -933,27 +934,27 @@ mkJSONOpInpVals tn cols = bool jsonbOpArgs [] $ null jsonbCols jsonbOpArgs = [appendArg, prependArg, deleteKeyArg, deleteElemArg, deleteAtPathArg] appendArg = - InpValInfo (Just appendDesc) appendOp Nothing $ G.toGT $ mkJSONOpTy tn appendOp + InpValInfo (Just appendDesc) appendOp Nothing Nothing $ G.toGT $ mkJSONOpTy tn appendOp prependArg = - InpValInfo (Just prependDesc) prependOp Nothing $ G.toGT $ mkJSONOpTy tn prependOp + InpValInfo (Just prependDesc) prependOp Nothing Nothing $ G.toGT $ mkJSONOpTy tn prependOp deleteKeyArg = - InpValInfo (Just deleteKeyDesc) deleteKeyOp Nothing $ + InpValInfo (Just deleteKeyDesc) deleteKeyOp Nothing Nothing $ G.toGT $ mkJSONOpTy tn deleteKeyOp deleteElemArg = - InpValInfo (Just deleteElemDesc) deleteElemOp Nothing $ + InpValInfo (Just deleteElemDesc) deleteElemOp Nothing Nothing $ G.toGT $ mkJSONOpTy tn deleteElemOp deleteAtPathArg = - InpValInfo (Just deleteAtPathDesc) deleteAtPathOp Nothing $ + InpValInfo (Just deleteAtPathDesc) deleteAtPathOp Nothing Nothing $ G.toGT $ mkJSONOpTy tn deleteAtPathOp mkUpdMutFld :: QualifiedTable -> [PGColInfo] -> ObjFldInfo mkUpdMutFld tn cols = - mkHsraObjFldInfo (Just desc) fldName (fromInpValL inputValues) $ + mkHsraObjFldInfo (Just desc) fldName (fromInpValL inputValues) Nothing $ G.toGT $ mkMutRespTy tn where inputValues = [filterArg, setArg] <> incArg @@ -964,12 +965,12 @@ mkUpdMutFld tn cols = filterArgDesc = "filter the rows which have to be updated" filterArg = - InpValInfo (Just filterArgDesc) "where" Nothing $ G.toGT $ + InpValInfo (Just filterArgDesc) "where" Nothing Nothing $ G.toGT $ G.toNT $ mkBoolExpTy tn setArgDesc = "sets the columns of the filtered rows to the given values" setArg = - InpValInfo (Just setArgDesc) "_set" Nothing $ G.toGT $ mkUpdSetTy tn + InpValInfo (Just setArgDesc) "_set" Nothing Nothing $ G.toGT $ mkUpdSetTy tn incArg = maybeToList $ mkIncInpVal tn cols @@ -984,7 +985,7 @@ delete_table( mkDelMutFld :: QualifiedTable -> ObjFldInfo mkDelMutFld tn = - mkHsraObjFldInfo (Just desc) fldName (fromInpValL [filterArg]) $ + mkHsraObjFldInfo (Just desc) fldName (fromInpValL [filterArg]) Nothing $ G.toGT $ mkMutRespTy tn where desc = G.Description $ "delete data from the table: " <>> tn @@ -993,7 +994,7 @@ mkDelMutFld tn = filterArgDesc = "filter the rows which have to be deleted" filterArg = - InpValInfo (Just filterArgDesc) "where" Nothing $ G.toGT $ + InpValInfo (Just filterArgDesc) "where" Nothing Nothing $ G.toGT $ G.toNT $ mkBoolExpTy tn -- table_insert_input @@ -1057,14 +1058,14 @@ mkRelInsInps mkRelInsInps tn upsertAllowed = [objRelInsInp, arrRelInsInp] where onConflictInpVal = - InpValInfo Nothing "on_conflict" Nothing $ G.toGT $ mkOnConflictInpTy tn + InpValInfo Nothing "on_conflict" Nothing Nothing $ G.toGT $ mkOnConflictInpTy tn onConflictInp = bool [] [onConflictInpVal] upsertAllowed objRelDesc = G.Description $ "input type for inserting object relation for remote table " <>> tn - objRelDataInp = InpValInfo Nothing "data" Nothing $ G.toGT $ + objRelDataInp = InpValInfo Nothing "data" Nothing Nothing $ G.toGT $ G.toNT $ mkInsInpTy tn objRelInsInp = mkHsraInpTyInfo (Just objRelDesc) (mkObjInsInpTy tn) $ fromInpValL $ objRelDataInp : onConflictInp @@ -1072,7 +1073,7 @@ mkRelInsInps tn upsertAllowed = [objRelInsInp, arrRelInsInp] arrRelDesc = G.Description $ "input type for inserting array relation for remote table " <>> tn - arrRelDataInp = InpValInfo Nothing "data" Nothing $ G.toGT $ + arrRelDataInp = InpValInfo Nothing "data" Nothing Nothing $ G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkInsInpTy tn arrRelInsInp = mkHsraInpTyInfo (Just arrRelDesc) (mkArrInsInpTy tn) $ fromInpValL $ arrRelDataInp : onConflictInp @@ -1106,9 +1107,9 @@ mkInsInp tn insCtx = let rty = riType relInfo remoteQT = riRTable relInfo in case rty of - ObjRel -> InpValInfo Nothing (G.Name $ getRelTxt relName) Nothing $ + ObjRel -> InpValInfo Nothing (G.Name $ getRelTxt relName) Nothing Nothing $ G.toGT $ mkObjInsInpTy remoteQT - ArrRel -> InpValInfo Nothing (G.Name $ getRelTxt relName) Nothing $ + ArrRel -> InpValInfo Nothing (G.Name $ getRelTxt relName) Nothing Nothing $ G.toGT $ mkArrInsInpTy remoteQT {- @@ -1129,10 +1130,10 @@ mkOnConflictInp tn = desc = G.Description $ "on conflict condition type for table " <>> tn - constraintInpVal = InpValInfo Nothing (G.Name "constraint") Nothing $ + constraintInpVal = InpValInfo Nothing (G.Name "constraint") Nothing Nothing $ G.toGT $ G.toNT $ mkConstraintInpTy tn - updateColumnsInpVal = InpValInfo Nothing (G.Name "update_columns") Nothing $ + updateColumnsInpVal = InpValInfo Nothing (G.Name "update_columns") Nothing Nothing $ G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkUpdColumnInpTy tn {- @@ -1145,7 +1146,7 @@ insert_table( mkInsMutFld :: QualifiedTable -> Bool -> ObjFldInfo mkInsMutFld tn isUpsertable = - mkHsraObjFldInfo (Just desc) fldName (fromInpValL inputVals) $ + mkHsraObjFldInfo (Just desc) fldName (fromInpValL inputVals) Nothing $ G.toGT $ mkMutRespTy tn where inputVals = catMaybes [Just objectsArg , onConflictInpVal] @@ -1156,14 +1157,14 @@ mkInsMutFld tn isUpsertable = objsArgDesc = "the rows to be inserted" objectsArg = - InpValInfo (Just objsArgDesc) "objects" Nothing $ G.toGT $ + InpValInfo (Just objsArgDesc) "objects" Nothing Nothing $ G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkInsInpTy tn onConflictInpVal = bool Nothing (Just onConflictArg) isUpsertable onConflictDesc = "on conflict condition" onConflictArg = - InpValInfo (Just onConflictDesc) "on_conflict" Nothing $ G.toGT $ mkOnConflictInpTy tn + InpValInfo (Just onConflictDesc) "on_conflict" Nothing Nothing $ G.toGT $ mkOnConflictInpTy tn mkConstriantTy :: QualifiedTable -> [ConstraintName] -> EnumTyInfo mkConstriantTy tn cons = enumTyInfo @@ -1262,7 +1263,7 @@ mkTabAggOpOrdByInpObjs tn numCols compCols = mkInpObjTy cols op = mkHsraInpTyInfo (Just $ mkDesc op) (mkTabAggOpOrdByTy tn op) $ fromInpValL $ map mkColInpVal cols - mkColInpVal c = InpValInfo Nothing (mkColName c) Nothing $ G.toGT + mkColInpVal c = InpValInfo Nothing (mkColName c) Nothing Nothing $ G.toGT ordByTy mkTabAggOrdByTy :: QualifiedTable -> G.NamedType @@ -1287,10 +1288,10 @@ mkTabAggOrdByInpObj tn numCols compCols = numOpOrdBys = bool (map mkInpValInfo numAggOps) [] $ null numCols compOpOrdBys = bool (map mkInpValInfo compAggOps) [] $ null compCols - mkInpValInfo op = InpValInfo Nothing op Nothing $ G.toGT $ + mkInpValInfo op = InpValInfo Nothing op Nothing Nothing $ G.toGT $ mkTabAggOpOrdByTy tn op - countInpVal = InpValInfo Nothing "count" Nothing $ G.toGT ordByTy + countInpVal = InpValInfo Nothing "count" Nothing Nothing $ G.toGT ordByTy mkOrdByTy :: QualifiedTable -> G.NamedType mkOrdByTy tn = @@ -1326,14 +1327,14 @@ mkOrdByInpObj tn selFlds = (inpObjTy, ordByCtx) objRels = relFltr ObjRel arrRels = relFltr ArrRel - mkColOrdBy ci = InpValInfo Nothing (mkColName $ pgiName ci) Nothing $ + mkColOrdBy ci = InpValInfo Nothing (mkColName $ pgiName ci) Nothing Nothing $ G.toGT ordByTy mkObjRelOrdBy (ri, _, _, _, _) = - InpValInfo Nothing (mkRelName $ riName ri) Nothing $ + InpValInfo Nothing (mkRelName $ riName ri) Nothing Nothing $ G.toGT $ mkOrdByTy $ riRTable ri mkArrRelAggOrdBy (ri, isAggAllowed, _, _, _) = - let ivi = InpValInfo Nothing (mkAggRelName $ riName ri) Nothing $ + let ivi = InpValInfo Nothing (mkAggRelName $ riName ri) Nothing Nothing $ G.toGT $ mkTabAggOrdByTy $ riRTable ri in bool Nothing (Just ivi) isAggAllowed @@ -1522,7 +1523,7 @@ mkGCtxRole' tn insPermM selPermM updColsM delPermM pkeyCols constraints viM func getNumCols = onlyNumCols . lefts getCompCols = onlyComparableCols . lefts - onlyFloat = const $ mkScalarTy PGFloat + onlyFloat = const $ mkScalarBaseTy PGFloat mkTypeMaker "sum" = mkScalarTy mkTypeMaker _ = onlyFloat diff --git a/server/src-lib/Hasura/GraphQL/Utils.hs b/server/src-lib/Hasura/GraphQL/Utils.hs index 6e779e013b87a..97388961f7e66 100644 --- a/server/src-lib/Hasura/GraphQL/Utils.hs +++ b/server/src-lib/Hasura/GraphQL/Utils.hs @@ -3,6 +3,7 @@ module Hasura.GraphQL.Utils , showName , showNamedTy , throwVE + , getArrDim , getBaseTy , mapFromL , groupTuples @@ -40,6 +41,11 @@ showNamedTy :: G.NamedType -> Text showNamedTy nt = "'" <> G.showNT nt <> "'" +getArrDim :: G.GType -> Integer +getArrDim = \case + G.TypeNamed{} -> 0 + G.TypeList _ lt -> 1 + getArrDim (G.unListType lt) + getBaseTy :: G.GType -> G.NamedType getBaseTy = \case G.TypeNamed _ n -> n diff --git a/server/src-lib/Hasura/GraphQL/Validate.hs b/server/src-lib/Hasura/GraphQL/Validate.hs index 8977db0d43eca..94edec9995a1c 100644 --- a/server/src-lib/Hasura/GraphQL/Validate.hs +++ b/server/src-lib/Hasura/GraphQL/Validate.hs @@ -56,14 +56,14 @@ getTypedOp opNameM selSets opDefs = -- For all the variables defined there will be a value in the final map -- If no default, not in variables and nullable, then null value -getAnnVarVals +getVarVals :: ( MonadReader r m, Has TypeMap r , MonadError QErr m ) => [G.VariableDefinition] -> VariableValues - -> m AnnVarVals -getAnnVarVals varDefsL inpVals = do + -> m VarVals +getVarVals varDefsL inpVals = do varDefs <- onLeft (mkMapWith G._vdVariable varDefsL) $ \dups -> throwVE $ "the following variables are defined more than once: " <> @@ -82,14 +82,19 @@ getAnnVarVals varDefsL inpVals = do when (isObjTy baseTyInfo) $ throwVE $ objTyErrMsg baseTy let defM' = bool (defM <|> Just G.VCNull) defM $ G.isNotNull ty - annDefM <- withPathK "defaultValue" $ - mapM (validateInputValue constValueParser ty) defM' let inpValM = Map.lookup var inpVals - annInpValM <- withPathK "variableValues" $ - mapM (validateInputValue jsonParser ty) inpValM - let varValM = annInpValM <|> annDefM - onNothing varValM $ throwVE $ "expecting a value for non-null type: " - <> G.showGT ty <> " in variableValues" + when (isNothing inpValM && isNothing defM') $ throwVE $ "expecting a value for non-null type: " <> G.showGT ty <> " in variableValues" + return (ty,defM',inpValM) + --let annValF pgTy = do + -- annDefM <- withPathK "defaultValue" $ + -- mapM (validateInputValue constValueParser ty pgTy) defM' + + -- annInpValM <- withPathK "variableValues" $ + -- mapM (validateInputValue jsonParser ty pgTy) inpValM + + -- let annValM = annInpValM <|> annDefM + -- onNothing annValM $ throwVE $ "expecting a value for non-null type: " <> G.showGT ty <> " in variableValues" + --return annValF where objTyErrMsg namedTy = "variables can only be defined on input types" @@ -131,7 +136,7 @@ validateGQ (QueryParts opDef opRoot fragDefsL varValsM) = do -- onNothing (_gSubRoot ctx) $ throwVE "no subscriptions exist" -- annotate the variables of this operation - annVarVals <- getAnnVarVals (G._todVariableDefinitions opDef) $ + annVarVals <- getVarVals (G._todVariableDefinitions opDef) $ fromMaybe Map.empty varValsM -- annotate the fragments diff --git a/server/src-lib/Hasura/GraphQL/Validate/Context.hs b/server/src-lib/Hasura/GraphQL/Validate/Context.hs index b82c133812f67..e25371570bc2d 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Context.hs @@ -27,9 +27,9 @@ getFieldInfo oti fldName = getInpFieldInfo :: ( MonadError QErr m) - => InpObjTyInfo -> G.Name -> m G.GType + => InpObjTyInfo -> G.Name -> m InpValInfo getInpFieldInfo tyInfo fldName = - fmap _iviType $ onNothing (Map.lookup fldName $ _iotiFields tyInfo) $ + onNothing (Map.lookup fldName $ _iotiFields tyInfo) $ throwVE $ "field " <> showName fldName <> " not found in type: " <> showNamedTy (_iotiName tyInfo) @@ -37,7 +37,7 @@ data ValidationCtx = ValidationCtx { _vcTypeMap :: !TypeMap -- these are in the scope of the operation - , _vcVarVals :: !AnnVarVals + , _vcVarVals :: !VarVals -- all the fragments , _vcFragDefMap :: !FragDefMap } deriving (Show, Eq) diff --git a/server/src-lib/Hasura/GraphQL/Validate/Field.hs b/server/src-lib/Hasura/GraphQL/Validate/Field.hs index 05b317baecea0..d6522eb7a9593 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Field.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Field.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PatternSynonyms #-} module Hasura.GraphQL.Validate.Field ( ArgsMap , Field(..) @@ -109,6 +110,8 @@ data FieldGroup -- throwGE :: (MonadError QErr m) => Text -> m a -- throwGE msg = throwError $ QErr msg [] +pattern PGBoolVal o b <- PGColValue o (PGValBase (PGValKnown (PGValBoolean b))) + withDirectives :: ( MonadReader ValidationCtx m , MonadError QErr m) @@ -141,7 +144,7 @@ withDirectives dirs act = do val <- onNothing (Map.lookup "if" m) $ throw500 "missing if argument in the directive" case val of - AGScalar _ (Just (PGValBoolean v)) -> return v + AGPGVal _ (Just (PGBoolVal _ v)) -> return v _ -> throw500 "did not find boolean scalar for if argument" denormSel @@ -166,6 +169,8 @@ denormSel visFrags parObjTyInfo sel = case sel of processArgs :: ( MonadReader ValidationCtx m + -- onNothing annValM $ throwVE $ "expecting a value for non-null type: " <> G.showGT ty <> " in variableValues" + --return annValF , MonadError QErr m) => ParamMap -> [G.Argument] @@ -181,7 +186,7 @@ processArgs fldParams argsL = do inpArgs <- forM args $ \(G.Argument argName argVal) -> withPathK (G.unName argName) $ do argTy <- getArgTy argName - validateInputValue valueParser argTy argVal + validateInputValue (valueParser $ _iviPGTy argTy) (_iviType argTy) (_iviPGTy argTy) argVal forM_ requiredParams $ \argDef -> do let param = _iviName argDef @@ -192,7 +197,7 @@ processArgs fldParams argsL = do where getArgTy argName = - onNothing (_iviType <$> Map.lookup argName fldParams) $ throwVE $ + onNothing (Map.lookup argName fldParams) $ throwVE $ "no such argument " <> showName argName <> " is expected" denormFld @@ -204,7 +209,7 @@ denormFld -> m (Maybe Field) denormFld visFrags fldInfo (G.Field aliasM name args dirs selSet) = do - let fldTy = _fiTy fldInfo + let fldTy = _fiTy fldInfo fldBaseTy = getBaseTy fldTy fldTyInfo <- getTyInfo fldBaseTy diff --git a/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs b/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs index dda739b62ca8e..6db757483697c 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs @@ -20,6 +20,7 @@ import qualified Data.Vector as V import qualified Language.GraphQL.Draft.Syntax as G import Hasura.GraphQL.Utils +import Hasura.SQL.Types import Hasura.GraphQL.Validate.Context import Hasura.GraphQL.Validate.Types import Hasura.RQL.Types @@ -36,13 +37,20 @@ pVal = return . P . Just . Right resolveVar :: ( MonadError QErr m , MonadReader ValidationCtx m) - => G.Variable -> m AnnGValue -resolveVar var = do + => Maybe PGColType -> G.Variable -> m AnnGValue +resolveVar pgTy var = do varVals <- _vcVarVals <$> ask -- TODO typecheck - onNothing (Map.lookup var varVals) $ + (ty,defM,inpValM) <- onNothing (Map.lookup var varVals) $ throwVE $ "no such variable defined in the operation: " <> showName (G.unVariable var) + annDefM <- withPathK "defaultValue" $ + mapM (validateInputValue constValueParser ty pgTy) defM + annInpValM <- withPathK "variableValues" $ + mapM (validateInputValue jsonParser ty pgTy) inpValM + let annValM = annInpValM <|> annDefM + onNothing annValM $ throwVE $ "expecting a value for non-null type: " <> G.showGT ty <> " in variableValues" + --return annValF where typeCheck expectedTy actualTy = case (expectedTy, actualTy) of -- named types @@ -54,9 +62,9 @@ resolveVar var = do pVar :: ( MonadError QErr m , MonadReader ValidationCtx m) - => G.Variable -> m (P a) -pVar var = do - annInpVal <- resolveVar var + => Maybe PGColType -> G.Variable -> m (P a) +pVar pgTy var = do + annInpVal <- resolveVar pgTy var return . P . Just . Left $ annInpVal data InputValueParser a m @@ -106,28 +114,28 @@ toJValue = \case valueParser :: ( MonadError QErr m , MonadReader ValidationCtx m) - => InputValueParser G.Value m -valueParser = + => Maybe PGColType -> InputValueParser G.Value m +valueParser pgTy = InputValueParser pScalar pList pObject pEnum where - pEnum (G.VVariable var) = pVar var + pEnum (G.VVariable var) = pVar pgTy var pEnum (G.VEnum e) = pVal e pEnum G.VNull = pNull pEnum _ = throwVE "expecting an enum" - pList (G.VVariable var) = pVar var + pList (G.VVariable var) = pVar pgTy var pList (G.VList lv) = pVal $ G.unListValue lv pList G.VNull = pNull pList v = pVal [v] - pObject (G.VVariable var) = pVar var + pObject (G.VVariable var) = pVar pgTy var pObject (G.VObject ov) = pVal [(G._ofName oFld, G._ofValue oFld) | oFld <- G.unObjectValue ov] pObject G.VNull = pNull pObject _ = throwVE "expecting an object" -- scalar json - pScalar (G.VVariable var) = pVar var + pScalar (G.VVariable var) = pVar pgTy var pScalar G.VNull = pNull pScalar (G.VInt v) = pVal $ J.Number $ fromIntegral v pScalar (G.VFloat v) = pVal $ J.Number $ fromFloatDigits v @@ -219,8 +227,8 @@ validateObject valParser tyInfo flds = do fmap OMap.fromList $ forM flds $ \(fldName, fldVal) -> withPathK (G.unName fldName) $ do - fldTy <- getInpFieldInfo tyInfo fldName - convFldVal <- validateInputValue valParser fldTy fldVal + fldInfo <- getInpFieldInfo tyInfo fldName + convFldVal <- validateInputValue valParser (_iviType fldInfo) (_iviPGTy fldInfo) fldVal return (fldName, convFldVal) where @@ -248,20 +256,18 @@ validateNamedTypeVal inpValParser nt val = do TIEnum eti -> withParsed (getEnum inpValParser) val $ fmap (AGEnum nt) . mapM (validateEnum eti) - TIScalar (ScalarTyInfo _ pgColTy _) -> - withParsed (getScalar inpValParser) val $ - fmap (AGScalar pgColTy) . mapM (validateScalar pgColTy) + TIScalar (ScalarTyInfo _ t _)-> + throwUnexpNoPGTyErr t where throwUnexpTypeErr ty = throw500 $ "unexpected " <> ty <> " type info for: " <> showNamedTy nt + throwUnexpNoPGTyErr ty = throw500 $ "No PGColType found for type " <> (G.unName ty) validateEnum enumTyInfo enumVal = if Map.member enumVal (_etiValues enumTyInfo) then return enumVal else throwVE $ "unexpected value " <> showName (G.unEnumValue enumVal) <> " for enum: " <> showNamedTy nt - validateScalar pgColTy = - runAesonParser (parsePGValue pgColTy) validateList :: (MonadError QErr m, MonadReader r m, Has TypeMap r) @@ -273,7 +279,7 @@ validateList inpValParser listTy val = withParsed (getList inpValParser) val $ \lM -> do let baseTy = G.unListType listTy AGArray listTy <$> - mapM (indexedMapM (validateInputValue inpValParser baseTy)) lM + mapM (indexedMapM (validateInputValue inpValParser baseTy Nothing)) lM -- validateNonNull -- :: (MonadError QErr m, MonadReader r m, Has TypeMap r) @@ -293,13 +299,17 @@ validateInputValue :: (MonadError QErr m, MonadReader r m, Has TypeMap r) => InputValueParser a m -> G.GType + -> Maybe PGColType -> a -> m AnnGValue -validateInputValue inpValParser ty val = +validateInputValue inpValParser ty Nothing val = case ty of G.TypeNamed _ nt -> validateNamedTypeVal inpValParser nt val G.TypeList _ lt -> validateList inpValParser lt val - --G.TypeNonNull nnt -> validateNonNull inpValParser nnt val +validateInputValue inpValParser _ (Just pgColTy) val = + withParsed (getScalar inpValParser) val $ + fmap (AGPGVal pgColTy) . mapM (validatePGVal pgColTy) + where validatePGVal pct = runAesonParser (parsePGValue pct) withParsed :: (Monad m) diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index 977baee9a27e8..a26ef22d4c62f 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Hasura.GraphQL.Validate.Types ( InpValInfo(..) , ParamMap @@ -10,7 +11,8 @@ module Hasura.GraphQL.Validate.Types , UnionTyInfo(..) , FragDef(..) , FragDefMap - , AnnVarVals +-- , AnnVarVals + , VarVals , EnumTyInfo(..) , EnumValInfo(..) , InpObjFldMap @@ -20,6 +22,7 @@ module Hasura.GraphQL.Validate.Types , AsObjType(..) , defaultDirectives , defDirectivesMap + , defaultPGColTyMap , defaultSchema , TypeInfo(..) , isObjTy @@ -27,7 +30,9 @@ module Hasura.GraphQL.Validate.Types , getPossibleObjTypes' , getObjTyM , getUnionTyM + , mkPGColGTy , mkScalarTy + , mkScalarBaseTy , pgColTyToScalar , pgColValToAnnGVal , getNamedTy @@ -44,6 +49,7 @@ module Hasura.GraphQL.Validate.Types , hasNullVal , getAnnInpValKind , getAnnInpValTy + , GQLColTyMap , module Hasura.GraphQL.Utils ) where @@ -109,6 +115,7 @@ data InpValInfo { _iviDesc :: !(Maybe G.Description) , _iviName :: !G.Name , _iviDefVal :: !(Maybe G.ValueConst) + , _iviPGTy :: !(Maybe PGColType) , _iviType :: !G.GType } deriving (Show, Eq, TH.Lift) @@ -116,9 +123,10 @@ instance EquatableGType InpValInfo where type EqProps InpValInfo = (G.Name, G.GType) getEqProps ity = (,) (_iviName ity) (_iviType ity) -fromInpValDef :: G.InputValueDefinition -> InpValInfo -fromInpValDef (G.InputValueDefinition descM n ty defM) = - InpValInfo descM n defM ty +fromInpValDef :: G.InputValueDefinition -> GQLColTyMap -> InpValInfo +fromInpValDef (G.InputValueDefinition descM n ty defM) gctm = + InpValInfo descM n defM pgTy ty + where pgTy = Map.lookup (getBaseTy ty, getArrDim ty) gctm type ParamMap = Map.HashMap G.Name InpValInfo @@ -135,6 +143,7 @@ data ObjFldInfo { _fiDesc :: !(Maybe G.Description) , _fiName :: !G.Name , _fiParams :: !ParamMap + , _fiPGTy :: !(Maybe PGColType) , _fiTy :: !G.GType , _fiLoc :: !TypeLoc } deriving (Show, Eq, TH.Lift) @@ -143,11 +152,12 @@ instance EquatableGType ObjFldInfo where type EqProps ObjFldInfo = (G.Name, G.GType, ParamMap) getEqProps o = (,,) (_fiName o) (_fiTy o) (_fiParams o) -fromFldDef :: G.FieldDefinition -> TypeLoc -> ObjFldInfo -fromFldDef (G.FieldDefinition descM n args ty _) loc = - ObjFldInfo descM n params ty loc +fromFldDef :: G.FieldDefinition -> GQLColTyMap -> TypeLoc -> ObjFldInfo +fromFldDef (G.FieldDefinition descM n args ty _) gctm loc = + ObjFldInfo descM n params pgTy ty loc where - params = Map.fromList [(G._ivdName arg, fromInpValDef arg) | arg <- args] + params = Map.fromList [(G._ivdName arg, fromInpValDef arg gctm) | arg <- args] + pgTy = Map.lookup (getBaseTy ty, getArrDim ty) gctm type ObjFieldMap = Map.HashMap G.Name ObjFldInfo @@ -188,16 +198,16 @@ mkIFaceTyInfo descM ty flds loc = typenameFld :: TypeLoc -> ObjFldInfo typenameFld loc = - ObjFldInfo (Just desc) "__typename" Map.empty + ObjFldInfo (Just desc) "__typename" Map.empty Nothing (G.toGT $ G.toNT $ G.NamedType "String") loc where desc = "The name of the current Object type at runtime" -fromObjTyDef :: G.ObjectTypeDefinition -> TypeLoc -> ObjTyInfo -fromObjTyDef (G.ObjectTypeDefinition descM n ifaces _ flds) loc = +fromObjTyDef :: G.ObjectTypeDefinition -> GQLColTyMap -> TypeLoc -> ObjTyInfo +fromObjTyDef (G.ObjectTypeDefinition descM n ifaces _ flds) gctm loc = mkObjTyInfo descM (G.NamedType n) (Set.fromList ifaces) fldMap loc where - fldMap = Map.fromList [(G._fldName fld, fromFldDef fld loc) | fld <- flds] + fldMap = Map.fromList [(G._fldName fld, fromFldDef fld gctm loc) | fld <- flds] data IFaceTyInfo = IFaceTyInfo @@ -219,11 +229,11 @@ instance Semigroup IFaceTyInfo where objA { _ifFields = Map.union (_ifFields objA) (_ifFields objB) } -fromIFaceDef :: G.InterfaceTypeDefinition -> TypeLoc -> IFaceTyInfo -fromIFaceDef (G.InterfaceTypeDefinition descM n _ flds) loc = +fromIFaceDef :: G.InterfaceTypeDefinition -> GQLColTyMap -> TypeLoc -> IFaceTyInfo +fromIFaceDef (G.InterfaceTypeDefinition descM n _ flds) gctm loc = mkIFaceTyInfo descM (G.NamedType n) fldMap loc where - fldMap = Map.fromList [(G._fldName fld, fromFldDef fld loc) | fld <- flds] + fldMap = Map.fromList [(G._fldName fld, fromFldDef fld gctm loc) | fld <- flds] type MemberTypes = Set.HashSet G.NamedType @@ -264,37 +274,30 @@ instance EquatableGType InpObjTyInfo where type EqProps InpObjTyInfo = (G.NamedType, Map.HashMap G.Name (G.Name, G.GType)) getEqProps a = (,) (_iotiName a) (Map.map getEqProps $ _iotiFields a) -fromInpObjTyDef :: G.InputObjectTypeDefinition -> TypeLoc -> InpObjTyInfo -fromInpObjTyDef (G.InputObjectTypeDefinition descM n _ inpFlds) loc = +fromInpObjTyDef :: G.InputObjectTypeDefinition -> GQLColTyMap -> TypeLoc -> InpObjTyInfo +fromInpObjTyDef (G.InputObjectTypeDefinition descM n _ inpFlds) gctm loc = InpObjTyInfo descM (G.NamedType n) fldMap loc where fldMap = Map.fromList - [(G._ivdName inpFld, fromInpValDef inpFld) | inpFld <- inpFlds] + [(G._ivdName inpFld, fromInpValDef inpFld gctm) | inpFld <- inpFlds] data ScalarTyInfo = ScalarTyInfo { _stiDesc :: !(Maybe G.Description) - , _stiType :: !PGColType + , _stiType :: !G.Name , _stiLoc :: !TypeLoc } deriving (Show, Eq, TH.Lift) instance EquatableGType ScalarTyInfo where - type EqProps ScalarTyInfo = PGColType + type EqProps ScalarTyInfo = G.Name getEqProps = _stiType fromScalarTyDef :: G.ScalarTypeDefinition -> TypeLoc -> Either Text ScalarTyInfo -fromScalarTyDef (G.ScalarTypeDefinition descM n _) loc = - ScalarTyInfo descM <$> ty <*> pure loc - where - ty = case n of - "Int" -> return PGInteger - "Float" -> return PGFloat - "String" -> return PGText - "Boolean" -> return PGBoolean - _ -> return $ txtToPgColTy $ G.unName n +fromScalarTyDef (G.ScalarTypeDefinition descM n _) loc + = return $ ScalarTyInfo descM n loc data TypeInfo = TIScalar !ScalarTyInfo @@ -492,9 +495,18 @@ isSubTypeBase subTyInfo supTyInfo = case (subTyInfo,supTyInfo) of showTy = showNamedTy . getNamedTy notSubTyErr = throwError $ "Type " <> showTy subTyInfo <> " is not a sub type of " <> showTy supTyInfo --- map postgres types to builtin scalars pgColTyToScalar :: PGColType -> Text -pgColTyToScalar = \case +pgColTyToScalar (PGColType qn _ _ d) = case d of + PGTyBase b -> pgBaseColTyToScalar b + _ -> qualTypeToScalar qn + where + qualTypeToScalar (QualifiedObject (SchemaName s) n) + | s `elem` ["pg_catalog","public"] = getTyText n + | otherwise = s <> "_" <> getTyText n + +-- map postgres types to builtin scalars +pgBaseColTyToScalar :: PGBaseColType -> Text +pgBaseColTyToScalar = \case PGInteger -> "Int" PGBoolean -> "Boolean" PGFloat -> "Float" @@ -502,13 +514,27 @@ pgColTyToScalar = \case PGVarchar -> "String" t -> T.pack $ show t +mkScalarBaseTy :: PGBaseColType -> G.NamedType +mkScalarBaseTy = + G.NamedType . G.Name . pgBaseColTyToScalar + +getPGColKind :: PGColType -> Text +getPGColKind colTy = case pgColTyDetails colTy of + PGTyArray{} -> "array" + _ -> "scalar" + +mkPGColGTy :: PGColType -> G.GType +mkPGColGTy colTy = case pgColTyDetails colTy of + PGTyArray t -> G.toGT $ G.toLT $ mkPGColGTy t + _ -> G.toGT $ mkScalarTy colTy + mkScalarTy :: PGColType -> G.NamedType mkScalarTy = G.NamedType . G.Name . pgColTyToScalar getNamedTy :: TypeInfo -> G.NamedType getNamedTy = \case - TIScalar t -> mkScalarTy $ _stiType t + TIScalar t -> G.NamedType $ _stiType t TIObj t -> _otiName t TIIFace i -> _ifName i TIEnum t -> _etiName t @@ -519,19 +545,19 @@ mkTyInfoMap :: [TypeInfo] -> TypeMap mkTyInfoMap tyInfos = Map.fromList [(getNamedTy tyInfo, tyInfo) | tyInfo <- tyInfos] -fromTyDef :: G.TypeDefinition -> TypeLoc -> Either Text TypeInfo -fromTyDef tyDef loc = case tyDef of +fromTyDef :: G.TypeDefinition -> GQLColTyMap -> TypeLoc -> Either Text TypeInfo +fromTyDef tyDef gctm loc = case tyDef of G.TypeDefinitionScalar t -> TIScalar <$> fromScalarTyDef t loc - G.TypeDefinitionObject t -> return $ TIObj $ fromObjTyDef t loc + G.TypeDefinitionObject t -> return $ TIObj $ fromObjTyDef t gctm loc G.TypeDefinitionInterface t -> - return $ TIIFace $ fromIFaceDef t loc + return $ TIIFace $ fromIFaceDef t gctm loc G.TypeDefinitionUnion t -> return $ TIUnion $ fromUnionTyDef t G.TypeDefinitionEnum t -> return $ TIEnum $ fromEnumTyDef t loc - G.TypeDefinitionInputObject t -> return $ TIInpObj $ fromInpObjTyDef t loc + G.TypeDefinitionInputObject t -> return $ TIInpObj $ fromInpObjTyDef t gctm loc -fromSchemaDoc :: G.SchemaDocument -> TypeLoc -> Either Text TypeMap -fromSchemaDoc (G.SchemaDocument tyDefs) loc = do - tyMap <- fmap mkTyInfoMap $ mapM (flip fromTyDef loc) tyDefs +fromSchemaDoc :: G.SchemaDocument -> GQLColTyMap -> TypeLoc -> Either Text TypeMap +fromSchemaDoc (G.SchemaDocument tyDefs) pctm loc = do + tyMap <- fmap mkTyInfoMap $ mapM (\x -> fromTyDef x pctm loc) tyDefs validateTypeMap tyMap return tyMap @@ -543,16 +569,29 @@ validateTypeMap tyMap = mapM_ validateTy $ Map.elems tyMap validateTy (TIIFace i) = validateIFace i validateTy _ = return () -fromTyDefQ :: G.TypeDefinition -> TypeLoc -> TH.Q TH.Exp -fromTyDefQ tyDef loc = case fromTyDef tyDef loc of +fromTyDefQ :: G.TypeDefinition -> GQLColTyMap -> TypeLoc -> TH.Q TH.Exp +fromTyDefQ tyDef pctm loc = case fromTyDef tyDef pctm loc of Left e -> fail $ T.unpack e Right t -> TH.lift t -fromSchemaDocQ :: G.SchemaDocument -> TypeLoc -> TH.Q TH.Exp -fromSchemaDocQ sd loc = case fromSchemaDoc sd loc of +fromSchemaDocQ :: G.SchemaDocument -> GQLColTyMap -> TypeLoc -> TH.Q TH.Exp +fromSchemaDocQ sd gctm loc = case fromSchemaDoc sd gctm loc of Left e -> fail $ T.unpack e Right tyMap -> TH.ListE <$> mapM TH.lift (Map.elems tyMap) +type ArrDim = Integer + +type GQLColTyMap = Map.HashMap (G.NamedType,ArrDim) PGColType + +defaultPGColTyMap :: GQLColTyMap +defaultPGColTyMap = Map.fromList $ + map (\(x,y) -> ( (G.NamedType $ G.Name x,0), baseBuiltInTy y)) $ + [ ("Int" , PGInteger) + , ("Float" , PGFloat ) + , ("String" , PGText ) + , ("Boolean", PGBoolean) + ] + defaultSchema :: G.SchemaDocument defaultSchema = $(G.parseSchemaDocQ "src-rsr/schema.graphql") @@ -577,7 +616,8 @@ defaultDirectives = [mkDirective "skip", mkDirective "include"] where mkDirective n = DirectiveInfo Nothing n args dirLocs - args = Map.singleton "if" $ InpValInfo Nothing "if" Nothing $ + args = Map.singleton "if" $ InpValInfo Nothing "if" Nothing + (Just $ baseBuiltInTy PGBoolean) $ G.TypeNamed (G.Nullability False) $ G.NamedType $ G.Name "Boolean" dirLocs = map G.DLExecutable [G.EDLFIELD, G.EDLFRAGMENT_SPREAD, G.EDLINLINE_FRAGMENT] @@ -594,13 +634,14 @@ data FragDef type FragDefMap = Map.HashMap G.Name FragDef -type AnnVarVals = - Map.HashMap G.Variable AnnGValue +type VarVals = + Map.HashMap G.Variable + (G.GType,Maybe G.DefaultValue,Maybe J.Value) type AnnGObject = OMap.InsOrdHashMap G.Name AnnGValue data AnnGValue - = AGScalar !PGColType !(Maybe PGColValue) + = AGPGVal !PGColType !(Maybe PGColValue) | AGEnum !G.NamedType !(Maybe G.EnumValue) | AGObject !G.NamedType !(Maybe AnnGObject) | AGArray !G.ListType !(Maybe [AnnGValue]) @@ -613,11 +654,11 @@ instance J.ToJSON AnnGValue where -- J.toJSON [J.toJSON ty, J.toJSON valM] pgColValToAnnGVal :: PGColType -> PGColValue -> AnnGValue -pgColValToAnnGVal colTy colVal = AGScalar colTy $ Just colVal +pgColValToAnnGVal colTy colVal = AGPGVal colTy $ Just colVal hasNullVal :: AnnGValue -> Bool hasNullVal = \case - AGScalar _ Nothing -> True + AGPGVal _ Nothing -> True AGEnum _ Nothing -> True AGObject _ Nothing -> True AGArray _ Nothing -> True @@ -625,14 +666,14 @@ hasNullVal = \case getAnnInpValKind :: AnnGValue -> Text getAnnInpValKind = \case - AGScalar _ _ -> "scalar" - AGEnum _ _ -> "enum" - AGObject _ _ -> "object" - AGArray _ _ -> "array" + AGPGVal pct _ -> getPGColKind pct + AGEnum{} -> "enum" + AGObject{} -> "object" + AGArray{} -> "array" getAnnInpValTy :: AnnGValue -> G.GType getAnnInpValTy = \case - AGScalar pct _ -> G.TypeNamed (G.Nullability True) $ G.NamedType $ G.Name $ T.pack $ show pct + AGPGVal pct _ -> mkPGColGTy pct AGEnum nt _ -> G.TypeNamed (G.Nullability True) nt AGObject nt _ -> G.TypeNamed (G.Nullability True) nt AGArray nt _ -> G.TypeList (G.Nullability True) nt diff --git a/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs b/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs index 5c65e13070fa8..571061a074123 100644 --- a/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs +++ b/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs @@ -20,7 +20,7 @@ import Hasura.RQL.GBoolExp import Hasura.RQL.Types import Hasura.Server.Utils import Hasura.SQL.Types -import Hasura.SQL.Value (withGeoVal) +import Hasura.SQL.Value (txtEncWithGeoVal) import qualified Database.PG.Query as Q import qualified Hasura.SQL.DML as S @@ -196,9 +196,10 @@ valueParser columnType = \case val -> txtRHSBuilder columnType val where curSess = S.SEUnsafe "current_setting('hasura.user')::json" - fromCurSess hdr = withAnnTy $ withGeoVal columnType $ + --TODO Nizar, Put the correct modification here + fromCurSess hdr = withAnnTy $ id $ S.SEOpApp (S.SQLOp "->>") [curSess, S.SELit $ T.toLower hdr] - withAnnTy v = S.SETyAnn v $ S.AnnType $ T.pack $ show columnType + withAnnTy v = S.SETyAnn v $ AnnType $ T.pack $ show columnType injectDefaults :: QualifiedTable -> QualifiedTable -> Q.Query injectDefaults qv qt = diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs b/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs new file mode 100644 index 0000000000000..bcd72b01655fd --- /dev/null +++ b/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs @@ -0,0 +1,93 @@ +module Hasura.RQL.DDL.Schema.PGType where + +import Hasura.GraphQL.Utils +import Hasura.Prelude +import Hasura.RQL.Types +import Hasura.SQL.Types + + +import qualified Data.HashSet as Set +import qualified Data.HashMap.Strict as Map +import qualified Data.Text as T +import qualified Database.PG.Query as Q + + +getPGTyInfoMap :: Q.TxE QErr PGTyInfoMaps +getPGTyInfoMap = do + pgTyInfo <- Q.catchE defaultTxErrorHandler $ + Q.listQ $(Q.sqlFromFile "src-rsr/pg_type_info.sql") () True + return $ mkPGTyMaps $ map (Q.getAltJ . runIdentity) pgTyInfo + +getPGColTys :: Set.HashSet PGColOidInfo -> Q.TxE QErr (Map.HashMap PGColOidInfo PGColType) +getPGColTys ctis = do + tim <- getPGTyInfoMap + fmap Map.fromList $ forM (Set.toList ctis) $ \x -> fmap ((,) x) $ onNothing (getPGColTy tim x) $ errMsg x + where + errMsg x = throw500 $ "Could not find Postgres type for oid " <> T.pack (show $ pcoiOid x) + +-- Do a union of given types and the required types from pg_catalog +addPGTysToCache :: (QErrM m, CacheRWM m, MonadTx m) => Set.HashSet PGColOidInfo -> m (Map.HashMap PGColOidInfo PGColType) +addPGTysToCache i = do + tysCache <- fmap scTyMap askSchemaCache + let inCache x = isJust $ Map.lookup x tysCache + if (all inCache i) + then return tysCache + else updatePGTysCache $ Set.union i $ Set.fromList $ Map.keys tysCache + +updatePGTysCache :: (CacheRWM m, MonadTx m) => Set.HashSet PGColOidInfo -> m (Map.HashMap PGColOidInfo PGColType) +updatePGTysCache iTys = do + cTys <- liftTx $ getCatalogTys + updTysMap <- liftTx $ getPGColTys $ Set.union cTys iTys + modPGTyCache updTysMap + return updTysMap + + +getCatalogTys :: Q.TxE QErr (Set.HashSet PGColOidInfo) +getCatalogTys = do + res <- Q.catchE defaultTxErrorHandler $ Q.listQ [Q.sql| + SELECT + ft.argOid :: int as oid, + case + when elemTy.oid is not null + then 1 + else 0 + end as dims + FROM + ( + SELECT DISTINCT unnest(COALESCE(pp.proallargtypes, pp.proargtypes::oid[])) as argOid + FROM + hdb_catalog.hdb_function hp + left outer join pg_proc pp + on + ( hp.function_name = pp.proname and + hp.function_schema = pp.pronamespace::regnamespace::text + ) + ) ft + left outer join pg_type elemTy + on ft.argOid = elemTy.typarray + + UNION + + SELECT DISTINCT + td.atttypid :: int as oid, + td.attndims as dims + FROM + hdb_catalog.hdb_table ht + left outer join information_schema.columns c + on ht.table_schema = c.table_schema and ht.table_name = c.table_name + left outer join ( + select pc.relnamespace, + pc.relname, + pa.attname, + pa.attndims, + pa.atttypid + from pg_attribute pa + left join pg_class pc + on pa.attrelid = pc.oid + ) td on + ( c.table_schema::regnamespace::oid = td.relnamespace + AND c.table_name = td.relname + AND c.column_name = td.attname + ) + |] () False + return $ Set.fromList $ flip map res $ \(oid, dims) -> PGColOidInfo oid (fromIntegral (dims :: Int)) diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs index 85b66c5adc46f..f679a51ef4160 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs @@ -10,10 +10,12 @@ import Hasura.RQL.DDL.Relationship import Hasura.RQL.DDL.RemoteSchema import Hasura.RQL.DDL.Schema.Diff import Hasura.RQL.DDL.Schema.Function +import Hasura.RQL.DDL.Schema.PGType import Hasura.RQL.DDL.Subscribe import Hasura.RQL.DDL.Utils import Hasura.RQL.Types import Hasura.Server.Utils (matchRegex) +import Hasura.GraphQL.Utils import Hasura.SQL.Types import qualified Database.PG.Query as Q @@ -27,6 +29,7 @@ import Language.Haskell.TH.Syntax (Lift) import Network.URI.Extended () import qualified Data.HashMap.Strict as M +import qualified Data.HashSet as S import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Database.PostgreSQL.LibPQ as PQ @@ -45,17 +48,37 @@ saveTableToCatalog (QualifiedObject sn tn) = INSERT INTO "hdb_catalog"."hdb_table" VALUES ($1, $2) |] (sn, tn) False +data PGColInfo' + = PGColInfo' + { pgipName :: !PGCol + , pgipType :: !PGColOidInfo + , pgipIsNullable :: !Bool + } deriving (Show, Eq) + + +$(deriveJSON (aesonDrop 4 snakeCase) ''PGColInfo') + -- Build the TableInfo with all its columns -getTableInfo :: QualifiedTable -> Bool -> Q.TxE QErr TableInfo +getTableInfo :: (QErrM m, CacheRWM m, MonadTx m) => + QualifiedTable -> Bool -> m TableInfo getTableInfo qt@(QualifiedObject sn tn) isSystemDefined = do - tableData <- Q.catchE defaultTxErrorHandler $ + tableData <- liftTx $ Q.catchE defaultTxErrorHandler $ Q.listQ $(Q.sqlFromFile "src-rsr/table_info.sql")(sn, tn) True case tableData of [] -> throw400 NotExists $ "no such table/view exists in postgres : " <>> qt - [(Q.AltJ cols, Q.AltJ pkeyCols, Q.AltJ cons, Q.AltJ viewInfoM)] -> + [(Q.AltJ cols', Q.AltJ pkeyCols, Q.AltJ cons, Q.AltJ viewInfoM)] -> do + cols <- toPGColTypes cols' return $ mkTableInfo qt isSystemDefined cons cols pkeyCols viewInfoM _ -> throw500 $ "more than one row found for: " <>> qt +toPGColTypes :: (CacheRWM m, MonadTx m) => [PGColInfo'] -> m [PGColInfo] +toPGColTypes cols' = do + pgTysMap <- addPGTysToCache $ S.fromList $ map pgipType cols' + forM cols' $ \(PGColInfo' na t nu) -> PGColInfo na <$> toColTy t pgTysMap <*> return nu + where + toColTy ci' typesMap = onNothing (M.lookup ci' typesMap) $ throw500 $ + "Could not find Postgres type with oid" <> T.pack (show $ pcoiOid ci') + newtype TrackTable = TrackTable { tName :: QualifiedTable } @@ -73,7 +96,7 @@ trackExistingTableOrViewP2Setup :: (QErrM m, CacheRWM m, MonadTx m) => QualifiedTable -> Bool -> m () trackExistingTableOrViewP2Setup tn isSystemDefined = do - ti <- liftTx $ getTableInfo tn isSystemDefined + ti <- getTableInfo tn isSystemDefined addTableToCache ti trackExistingTableOrViewP2 diff --git a/server/src-lib/Hasura/RQL/DML/Internal.hs b/server/src-lib/Hasura/RQL/DML/Internal.hs index 604280be59584..a8966ee9d1aae 100644 --- a/server/src-lib/Hasura/RQL/DML/Internal.hs +++ b/server/src-lib/Hasura/RQL/DML/Internal.hs @@ -221,16 +221,22 @@ dmlTxErrorHandler p2Res = where err = simplifyError p2Res toJSONableExp :: PGColType -> S.SQLExp -> S.SQLExp -toJSONableExp colTy expn +toJSONableExp colTy expn = case pgColTyDetails colTy of + PGTyBase b -> toJSONableExp' b expn + --TODO Handle the case with an array of geometry types + _ -> expn + +toJSONableExp' :: PGBaseColType -> S.SQLExp -> S.SQLExp +toJSONableExp' colTy expn | colTy == PGGeometry || colTy == PGGeography = S.SEFnApp "ST_AsGeoJSON" [ expn , S.SEUnsafe "15" -- max decimal digits , S.SEUnsafe "4" -- to print out crs ] Nothing - `S.SETyAnn` S.jsonType + `S.SETyAnn` jsonType | colTy == PGBigInt || colTy == PGBigSerial = - expn `S.SETyAnn` S.textType + expn `S.SETyAnn` textType | otherwise = expn -- validate headers diff --git a/server/src-lib/Hasura/RQL/DML/Select.hs b/server/src-lib/Hasura/RQL/DML/Select.hs index 930eb69654ab1..05b87333918a8 100644 --- a/server/src-lib/Hasura/RQL/DML/Select.hs +++ b/server/src-lib/Hasura/RQL/DML/Select.hs @@ -112,7 +112,10 @@ convOrderByElem (flds, spi) = \case FIColumn colInfo -> do checkSelOnCol spi (pgiName colInfo) let ty = pgiType colInfo - if ty == PGGeography || ty == PGGeometry + let asBaseTy = case pgColTyDetails ty of + PGTyBase b -> Just b + _ -> Nothing + if asBaseTy `elem` map Just [PGGeography, PGGeometry] then throw400 UnexpectedPayload $ mconcat [ fldName <<> " has type 'geometry'" , " and cannot be used in order_by" diff --git a/server/src-lib/Hasura/RQL/GBoolExp.hs b/server/src-lib/Hasura/RQL/GBoolExp.hs index cb1e3d2e192ae..ac8f1f1927926 100644 --- a/server/src-lib/Hasura/RQL/GBoolExp.hs +++ b/server/src-lib/Hasura/RQL/GBoolExp.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PatternSynonyms #-} module Hasura.RQL.GBoolExp ( toSQLBoolExp , getBoolExpDeps @@ -18,6 +19,8 @@ import Data.Aeson import qualified Data.HashMap.Strict as M import qualified Data.Text.Extended as T +pattern PGGeomTy a b c = PGColType a b c (PGTyBase PGGeometry) + parseOpExp :: (MonadError QErr m) => ValueParser m a @@ -77,8 +80,8 @@ parseOpExp parser fim (PGColInfo cn colTy _) (opStr, val) = withErrPath $ "$contains" -> jsonbOnlyOp $ AContains <$> parseOne "_contained_in" -> jsonbOnlyOp $ AContainedIn <$> parseOne "$contained_in" -> jsonbOnlyOp $ AContainedIn <$> parseOne - "_has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy PGText - "$has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy PGText + "_has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy (baseBuiltInTy PGText) + "$has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy (baseBuiltInTy PGText) --FIXME:- Parse a session variable as text array values --TODO:- Add following commented operators after fixing above said @@ -154,16 +157,16 @@ parseOpExp parser fim (PGColInfo cn colTy _) (opStr, val) = withErrPath $ parseCgte = CGTE <$> decodeAndValidateRhsCol parseClte = CLTE <$> decodeAndValidateRhsCol - jsonbOnlyOp m = case colTy of - PGJSONB -> m - ty -> throwError $ buildMsg ty [PGJSONB] + jsonbOnlyOp m = case pgColTyDetails colTy of + PGTyBase PGJSONB -> m + _ -> throwError $ buildMsg colTy [baseBuiltInTy PGJSONB] parseGeometryOp f = geometryOnlyOp colTy >> f <$> parseOne parseSTDWithinObj = do WithinOp distVal fromVal <- parseVal - dist <- withPathK "distance" $ parser PGFloat distVal + dist <- withPathK "distance" $ parser (baseBuiltInTy PGFloat) distVal from <- withPathK "from" $ parser colTy fromVal return $ ASTDWithin $ WithinOp dist from @@ -178,9 +181,9 @@ parseOpExp parser fim (PGColInfo cn colTy _) (opStr, val) = withErrPath $ "incompatible column types : " <> cn <<> ", " <>> rhsCol else return rhsCol - geometryOnlyOp PGGeometry = return () + geometryOnlyOp (PGGeomTy{}) = return () geometryOnlyOp ty = - throwError $ buildMsg ty [PGGeometry] + throwError $ buildMsg ty [baseBuiltInTy PGGeometry] parseWithTy ty = parser ty val parseOne = parseWithTy colTy @@ -213,11 +216,14 @@ buildMsg ty expTys = , T.intercalate "/" $ map (T.dquote . T.pack . show) expTys ] -textOnlyOp :: (MonadError QErr m) => PGColType -> m () -textOnlyOp PGText = return () -textOnlyOp PGVarchar = return () -textOnlyOp ty = - throwError $ buildMsg ty [PGVarchar, PGText] +textOnlyOp colTy = case pgColTyDetails colTy of + PGTyBase b -> textOnlyOp' b + _ -> onlyTxtTyErr + where + textOnlyOp' PGText = return () + textOnlyOp' PGVarchar = return () + textOnlyOp' ty = onlyTxtTyErr + onlyTxtTyErr = throwError $ buildMsg colTy $ baseBuiltInTy <$> [PGVarchar, PGText] -- This convoluted expression instead of col = val -- to handle the case of col : null @@ -244,6 +250,8 @@ annBoolExp annBoolExp valParser fim (BoolExp boolExp) = traverse (annColExp valParser fim) boolExp +pattern JSONCol a b x y z = PGColInfo a (PGColType x y z (PGTyBase PGJSON)) b + annColExp :: (QErrM m, CacheRM m) => ValueParser m a @@ -253,7 +261,7 @@ annColExp annColExp valueParser colInfoMap (ColExp fieldName colVal) = do colInfo <- askFieldInfo colInfoMap fieldName case colInfo of - FIColumn (PGColInfo _ PGJSON _) -> + FIColumn (JSONCol{}) -> throwError (err400 UnexpectedPayload "JSON column can not be part of where clause") -- FIColumn (PGColInfo _ PGJSONB _) -> -- throwError (err400 UnexpectedPayload "JSONB column can not be part of where clause") @@ -359,7 +367,7 @@ mkColCompExp qual lhsCol = \case lhs = mkQCol lhsCol toTextArray arr = - S.SETyAnn (S.SEArray $ map (txtEncoder . PGValText) arr) S.textArrType + S.SETyAnn (S.SEArray $ map (txtEncoder' . PGValKnown . PGValText) arr) textArrType mkGeomOpBe fn v = applySQLFn fn [lhs, v] diff --git a/server/src-lib/Hasura/RQL/Instances.hs b/server/src-lib/Hasura/RQL/Instances.hs index 9a7f97c6eee0e..5cb818aac4c96 100644 --- a/server/src-lib/Hasura/RQL/Instances.hs +++ b/server/src-lib/Hasura/RQL/Instances.hs @@ -7,11 +7,38 @@ import Hasura.Prelude import Instances.TH.Lift () import qualified Language.Haskell.TH.Syntax as TH +import qualified Data.Aeson as J import qualified Data.HashMap.Strict as M +import qualified Data.HashMap.Strict.InsOrd as OMap import qualified Data.HashSet as S +import qualified Database.PostgreSQL.LibPQ as PQ (Oid (..)) +import Foreign.C.Types +import Data.Hashable +import qualified Database.PG.Query as Q +import qualified PostgreSQL.Binary.Decoding as PD + instance (TH.Lift k, TH.Lift v) => TH.Lift (M.HashMap k v) where lift m = [| M.fromList $(TH.lift $ M.toList m) |] +instance (TH.Lift k, TH.Lift v) => TH.Lift (OMap.InsOrdHashMap k v) where + lift m = [| OMap.fromList $(TH.lift $ OMap.toList m) |] + instance TH.Lift a => TH.Lift (S.HashSet a) where lift s = [| S.fromList $(TH.lift $ S.toList s) |] + +instance J.FromJSON PQ.Oid where + parseJSON v = fmap (PQ.Oid . CUInt) $ J.parseJSON v + +instance J.ToJSON PQ.Oid where + toJSON (PQ.Oid (CUInt i)) = J.toJSON i + +instance Hashable PQ.Oid where + hashWithSalt s (PQ.Oid (CUInt w)) = hashWithSalt s w + +instance TH.Lift PQ.Oid where + lift (PQ.Oid (CUInt w)) = [| PQ.Oid (CUInt $(TH.lift w)) |] + +instance Q.FromCol PQ.Oid where + fromCol x = fmap (PQ.Oid . CUInt) $ Q.fromColHelper PD.int x + diff --git a/server/src-lib/Hasura/RQL/Types/Common.hs b/server/src-lib/Hasura/RQL/Types/Common.hs index e0b10943141a4..c83fa19f2aa6f 100644 --- a/server/src-lib/Hasura/RQL/Types/Common.hs +++ b/server/src-lib/Hasura/RQL/Types/Common.hs @@ -14,6 +14,12 @@ module Hasura.RQL.Types.Common , ToAesonPairs(..) , WithTable(..) + + , mkPGTyMaps + , PGTyInfoMaps + , PGColOidInfo(..) + , PGTyInfo(..) + , getPGColTy ) where import Hasura.Prelude @@ -22,12 +28,95 @@ import Hasura.SQL.Types import Data.Aeson import Data.Aeson.Casing import Data.Aeson.TH +import qualified Data.HashMap.Strict as Map +import qualified Data.HashMap.Strict.InsOrd as OMap import qualified Data.Text as T import qualified Database.PG.Query as Q +import qualified Database.PostgreSQL.LibPQ as PQ (Oid) import Instances.TH.Lift () import Language.Haskell.TH.Syntax (Lift) import qualified PostgreSQL.Binary.Decoding as PD +newtype PGColOid = PGColOid { getOid :: Text } + deriving(Show, Eq, FromJSON, ToJSON) + +data PGDomBaseTyInfo + = PGDomBaseTyInfo + { pcdbDimension :: Integer } deriving (Show, Eq) + +$(deriveJSON (aesonDrop 4 camelCase) ''PGDomBaseTyInfo ) + + +type PGCompTyFldMap = [Map.HashMap PGTyFldName PGColOidInfo] + +data PGTyInfo' + = PGTBase + | PGTRange + | PGTPseudo + | PGTArray { pgtaElemOid :: !PQ.Oid } + | PGTDomain { pgtdBaseType :: !PGColOidInfo } + | PGTEnum { pgtePossibleValues :: ![EnumVal] } + | PGTComposite { pgtcFields :: !PGCompTyFldMap } + deriving (Show, Eq) + +data PGTyInfo + = PGTyInfo + { ptiName :: !QualifiedType + , ptiOid :: !PQ.Oid + , ptiSqlName :: !AnnType + , ptiDetail :: !PGTyInfo' + } deriving (Show, Eq) + +data PGColOidInfo + = PGColOidInfo + { pcoiOid :: PQ.Oid + , pcoiDimension :: Integer + } deriving (Show, Eq, Generic) + +instance Hashable PGColOidInfo + +instance ToJSONKey PGColOidInfo + +type PGTyInfoMaps = + ( Map.HashMap PQ.Oid QualifiedType + , Map.HashMap QualifiedType PGTyInfo + ) + +mkPGTyMaps :: [PGTyInfo] -> PGTyInfoMaps +mkPGTyMaps x = + ( Map.fromList $ flip map x $ \y -> (ptiOid y, ptiName y) + , Map.fromList $ flip map x $ \y -> (ptiName y, y) + ) + +getPGColTy :: PGTyInfoMaps -> PGColOidInfo -> Maybe PGColType +getPGColTy maps@(oidNameMap,nameTyMap) (PGColOidInfo oid dims) = do + PGTyInfo name _ sqlName tyDtls <- getTyOfOid oid + fmap (PGColType name sqlName oid) $ case tyDtls of + PGTRange -> return PGTyRange + PGTPseudo -> return PGTyPseudo + PGTBase -> return $ PGTyBase $ txtToPgBaseColTy $ getTyText $ qName name + PGTEnum x -> return $ PGTyEnum x + PGTComposite x -> fmap PGTyComposite $ mapM getSubTy $ OMap.fromList $ concatMap Map.toList x + PGTDomain bct -> fmap PGTyDomain $ getSubTy bct + PGTArray bOid -> do + let asDimArray n y + | n > 1 = PGTyArray $ PGColType name sqlName oid $ asDimArray (n-1) y + | otherwise = PGTyArray y + fmap (asDimArray dims) $ getSubTy (PGColOidInfo bOid 0) + where + getTyOfOid = (flip Map.lookup oidNameMap) >=> (flip Map.lookup nameTyMap) + getSubTy = getPGColTy maps + + +$(deriveJSON (aesonDrop 4 snakeCase) ''PGColOidInfo) +$(deriveJSON + (aesonDrop 4 snakeCase) + { constructorTagModifier = snakeCase . drop 3 + , sumEncoding = TaggedObject "type" "detail" + } + ''PGTyInfo') +$(deriveJSON (aesonDrop 3 snakeCase) ''PGTyInfo) + data PGColInfo = PGColInfo { pgiName :: !PGCol diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index 20167b2883ab6..d86fc035f87a2 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -20,6 +20,7 @@ module Hasura.RQL.Types.SchemaCache , mkTableInfo , addTableToCache , modTableInCache + , modPGTyCache , delTableFromCache , WithDeps @@ -95,6 +96,8 @@ module Hasura.RQL.Types.SchemaCache , addFunctionToCache , askFunctionInfo , delFunctionFromCache + + , PGTyCache ) where import qualified Hasura.GraphQL.Context as GC @@ -183,6 +186,7 @@ partitionFieldInfosWith fns = biMapEither (f1, f2) = either (Left . f1) (Right . f2) type FieldInfoMap = M.HashMap FieldName FieldInfo +--type FieldInfoMap' = M.HashMap FieldName FieldInfo' getCols :: FieldInfoMap -> [PGColInfo] getCols fim = lefts $ map fieldInfoToEither $ M.elems fim @@ -402,6 +406,7 @@ $(deriveToJSON (aesonDrop 2 snakeCase) ''FunctionInfo) type TableCache = M.HashMap QualifiedTable TableInfo -- info of all tables type FunctionCache = M.HashMap QualifiedFunction FunctionInfo -- info of all functions +type PGTyCache = M.HashMap PGColOidInfo PGColType type DepMap = M.HashMap SchemaObjId (HS.HashSet SchemaDependency) @@ -429,6 +434,7 @@ data SchemaCache , scGCtxMap :: !GC.GCtxMap , scDefaultRemoteGCtx :: !GC.GCtx , scDepMap :: !DepMap + , scTyMap :: !PGTyCache } deriving (Show, Eq) $(deriveToJSON (aesonDrop 2 snakeCase) ''SchemaCache) @@ -452,7 +458,6 @@ instance (Monad m) => CacheRM (StateT SchemaCache m) where askSchemaCache = get class (CacheRM m) => CacheRWM m where - -- Get the schema cache writeSchemaCache :: SchemaCache -> m () @@ -493,13 +498,19 @@ delQTemplateFromCache qtn = do emptySchemaCache :: SchemaCache emptySchemaCache = - SchemaCache (M.fromList []) M.empty (M.fromList []) M.empty M.empty GC.emptyGCtx mempty + SchemaCache (M.fromList []) M.empty (M.fromList []) M.empty M.empty GC.emptyGCtx mempty mempty modTableCache :: (CacheRWM m) => TableCache -> m () modTableCache tc = do sc <- askSchemaCache writeSchemaCache $ sc { scTables = tc } +modPGTyCache :: (CacheRWM m) => PGTyCache -> m () +modPGTyCache tm = do + sc <- askSchemaCache + writeSchemaCache $ sc { scTyMap = tm } + + addTableToCache :: (QErrM m, CacheRWM m) => TableInfo -> m () addTableToCache ti = do diff --git a/server/src-lib/Hasura/SQL/DML.hs b/server/src-lib/Hasura/SQL/DML.hs index e4d0a4ca617ba..c73a9d01ed480 100644 --- a/server/src-lib/Hasura/SQL/DML.hs +++ b/server/src-lib/Hasura/SQL/DML.hs @@ -218,25 +218,6 @@ jsonbDeleteOp = SQLOp "-" jsonbDeleteAtPathOp :: SQLOp jsonbDeleteAtPathOp = SQLOp "#-" -newtype AnnType - = AnnType {unAnnType :: T.Text} - deriving (Show, Eq) - -intType :: AnnType -intType = AnnType "int" - -textType :: AnnType -textType = AnnType "text" - -textArrType :: AnnType -textArrType = AnnType "text[]" - -jsonType :: AnnType -jsonType = AnnType "json" - -jsonbType :: AnnType -jsonbType = AnnType "jsonb" - data CountType = CTStar | CTSimple ![PGCol] @@ -331,7 +312,7 @@ intToSQLExp = annotateExp :: SQLExp -> PGColType -> SQLExp annotateExp sqlExp = - SETyAnn sqlExp . AnnType . T.pack . show + SETyAnn sqlExp . pgColTySqlName data Extractor = Extractor !SQLExp !(Maybe Alias) deriving (Show, Eq) diff --git a/server/src-lib/Hasura/SQL/Types.hs b/server/src-lib/Hasura/SQL/Types.hs index e171cb5afdf47..94158535451f5 100644 --- a/server/src-lib/Hasura/SQL/Types.hs +++ b/server/src-lib/Hasura/SQL/Types.hs @@ -1,21 +1,27 @@ +{-# LANGUAGE TemplateHaskell #-} module Hasura.SQL.Types where import qualified Database.PG.Query as Q import qualified Database.PG.Query.PTI as PTI import Hasura.Prelude +import Hasura.RQL.Instances () import Data.Aeson +import Data.Aeson.TH +import Data.Aeson.Casing import Data.Aeson.Encoding (text) import Data.String (fromString) import Instances.TH.Lift () import Language.Haskell.TH.Syntax (Lift) +import qualified Data.HashMap.Strict.InsOrd as OMap import qualified Data.Text.Extended as T import qualified Database.PostgreSQL.LibPQ as PQ import qualified PostgreSQL.Binary.Decoding as PD import qualified Text.Builder as TB + class ToSQL a where toSQL :: a -> TB.Builder @@ -164,6 +170,9 @@ newtype SchemaName publicSchema :: SchemaName publicSchema = SchemaName "public" +catalogSchema :: SchemaName +catalogSchema = SchemaName "catalog" + instance IsIden SchemaName where toIden (SchemaName t) = Iden t @@ -207,6 +216,7 @@ instance (ToSQL a) => ToSQL (QualifiedObject a) where qualObjectToText :: ToTxt a => QualifiedObject a -> T.Text qualObjectToText (QualifiedObject sn o) + | sn == catalogSchema = toTxt o | sn == publicSchema = toTxt o | otherwise = getSchemaTxt sn <> "." <> toTxt o @@ -240,7 +250,43 @@ showPGCols :: (Foldable t) => t PGCol -> T.Text showPGCols cols = T.intercalate ", " $ map (T.dquote . getPGColTxt) $ toList cols -data PGColType +newtype AnnType + = AnnType {unAnnType :: T.Text} + deriving (Show, Eq, Generic, Lift, ToJSON, FromJSON) + +instance Hashable AnnType + +intType :: AnnType +intType = AnnType "int" + +textType :: AnnType +textType = AnnType "text" + +textArrType :: AnnType +textArrType = AnnType "text[]" + +jsonType :: AnnType +jsonType = AnnType "json" + +jsonbType :: AnnType +jsonbType = AnnType "jsonb" + +newtype PGTyFldName = PGTyFldName { getTyFldText :: T.Text } + deriving (Show, Eq, FromJSON, ToJSON, ToJSONKey, FromJSONKey, Hashable, Q.ToPrepArg, Q.FromCol, Lift) + + +newtype EnumVal = EnumVal { getEnumVal :: T.Text } + deriving (Show, Eq, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, Lift) + +newtype PGTyName = PGTyName { getTyText :: T.Text } + deriving (Show, Eq, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, Lift) + +instance ToTxt PGTyName where + toTxt = getTyText + +type QualifiedType = QualifiedObject PGTyName + +data PGBaseColType = PGSmallInt | PGInteger | PGBigInt @@ -263,39 +309,16 @@ data PGColType | PGUnknown !T.Text deriving (Eq, Lift, Generic) -instance Hashable PGColType - -instance Show PGColType where - show PGSmallInt = "smallint" - show PGInteger = "integer" - show PGBigInt = "bigint" - show PGSerial = "serial" - show PGBigSerial = "bigserial" - show PGFloat = "real" - show PGDouble = "float8" - show PGNumeric = "numeric" - show PGBoolean = "boolean" - show PGChar = "character" - show PGVarchar = "varchar" - show PGText = "text" - show PGDate = "date" - show PGTimeStampTZ = "timestamptz" - show PGTimeTZ = "timetz" - show PGJSON = "json" - show PGJSONB = "jsonb" - show PGGeometry = "geometry" - show PGGeography = "geography" - show (PGUnknown t) = T.unpack t +instance Hashable PGBaseColType -instance ToJSON PGColType where +instance ToJSON PGBaseColType where toJSON pct = String $ T.pack $ show pct -instance ToSQL PGColType where +instance ToSQL PGBaseColType where toSQL pct = fromString $ show pct - -txtToPgColTy :: Text -> PGColType -txtToPgColTy t = case t of +txtToPgBaseColTy :: Text -> PGBaseColType +txtToPgBaseColTy t = case t of "serial" -> PGSerial "bigserial" -> PGBigSerial @@ -343,13 +366,75 @@ txtToPgColTy t = case t of "geography" -> PGGeography _ -> PGUnknown t +instance FromJSON PGBaseColType where + parseJSON (String t) = return $ txtToPgBaseColTy t + parseJSON _ = fail "Expecting a string for PGBaseColType" -instance FromJSON PGColType where - parseJSON (String t) = return $ txtToPgColTy t - parseJSON _ = fail "Expecting a string for PGColType" +instance Show PGBaseColType where + show PGSmallInt = "smallint" + show PGInteger = "integer" + show PGBigInt = "bigint" + show PGSerial = "serial" + show PGBigSerial = "bigserial" + show PGFloat = "real" + show PGDouble = "float8" + show PGNumeric = "numeric" + show PGBoolean = "boolean" + show PGChar = "character" + show PGVarchar = "varchar" + show PGText = "text" + show PGDate = "date" + show PGTimeStampTZ = "timestamptz" + show PGTimeTZ = "timetz" + show PGJSON = "json" + show PGJSONB = "jsonb" + show PGGeometry = "geometry" + show PGGeography = "geography" + show (PGUnknown t) = T.unpack t + +data PGColTyDetails + = PGTyComposite !(OMap.InsOrdHashMap PGTyFldName PGColType) + | PGTyArray !PGColType + | PGTyDomain !PGColType + | PGTyBase !PGBaseColType + | PGTyEnum ![EnumVal] + | PGTyRange + | PGTyPseudo + deriving (Show, Eq, Lift, Generic) + +instance Hashable PGColTyDetails + +getArrayBaseTy :: PGColType -> Maybe PGColType +getArrayBaseTy (PGColType _ _ _ x) = case x of + PGTyArray a@(PGColType _ _ _ y) -> case y of + PGTyArray{} -> getArrayBaseTy a + _ -> Just a + _ -> Nothing +data PGColType + = PGColType + { pgColTyName :: !QualifiedType + , pgColTySqlName :: !AnnType + , pgColTyOid :: !PQ.Oid + , pgColTyDetails :: !PGColTyDetails + } deriving (Show, Eq, Lift, Generic) + +$(deriveJSON + defaultOptions { constructorTagModifier = snakeCase . drop 4 + , sumEncoding = TaggedObject "type" "detail" + } + ''PGColTyDetails) +$(deriveJSON (aesonDrop 7 camelCase) ''PGColType) + +baseBuiltInTy :: PGBaseColType -> PGColType +baseBuiltInTy b = PGColType qualfdType (AnnType name) (pgTypeOid b)$ PGTyBase b + where + qualfdType = QualifiedObject (SchemaName "pg_catalog") (PGTyName name) + name = T.pack $ show b + +instance Hashable PGColType -pgTypeOid :: PGColType -> PQ.Oid +pgTypeOid :: PGBaseColType -> PQ.Oid pgTypeOid PGSmallInt = PTI.int2 pgTypeOid PGInteger = PTI.int4 pgTypeOid PGBigInt = PTI.int8 @@ -372,27 +457,53 @@ pgTypeOid PGGeometry = PTI.text pgTypeOid PGGeography = PTI.text pgTypeOid (PGUnknown _) = PTI.auto + isIntegerType :: PGColType -> Bool -isIntegerType PGInteger = True -isIntegerType PGSmallInt = True -isIntegerType PGBigInt = True -isIntegerType _ = False +isIntegerType = onBaseUDT False isIntegerType' isNumType :: PGColType -> Bool -isNumType PGFloat = True -isNumType PGDouble = True -isNumType PGNumeric = True -isNumType ty = isIntegerType ty +isNumType = onBaseUDT False isNumType' isJSONBType :: PGColType -> Bool -isJSONBType PGJSONB = True -isJSONBType _ = False +isJSONBType = onBaseUDT False isJSONBType' +--any numeric, string, date/time, network, or enum type, or arrays of these types isComparableType :: PGColType -> Bool -isComparableType PGJSON = False -isComparableType PGJSONB = False -isComparableType PGGeometry = False -isComparableType PGGeography = False -isComparableType PGBoolean = False -isComparableType (PGUnknown _) = False -isComparableType _ = True +isComparableType t = case pgColTyDetails t of + PGTyArray a -> isComparableType a + PGTyDomain a -> isComparableType a + PGTyBase b -> isComparableType' b + PGTyEnum{} -> True + _ -> False + +-- Apply the function if the underlying data type is a base data type. Otherwise return the default value +onBaseUDT :: a -> (PGBaseColType -> a) -> PGColType -> a +onBaseUDT def f t = case pgColTyDetails t of + PGTyBase b -> f b + PGTyDomain a -> onBaseUDT def f a + _ -> def + +isIntegerType' :: PGBaseColType -> Bool +isIntegerType' PGInteger = True +isIntegerType' PGSmallInt = True +isIntegerType' PGBigInt = True +isIntegerType' _ = False + +isNumType' :: PGBaseColType -> Bool +isNumType' PGFloat = True +isNumType' PGDouble = True +isNumType' PGNumeric = True +isNumType' ty = isIntegerType' ty + +isJSONBType' :: PGBaseColType -> Bool +isJSONBType' PGJSONB = True +isJSONBType' _ = False + +isComparableType' :: PGBaseColType -> Bool +isComparableType' PGJSON = False +isComparableType' PGJSONB = False +isComparableType' PGGeometry = False +isComparableType' PGGeography = False +isComparableType' PGBoolean = False +isComparableType' (PGUnknown _) = False +isComparableType' _ = True diff --git a/server/src-lib/Hasura/SQL/Value.hs b/server/src-lib/Hasura/SQL/Value.hs index d5de51ea2358d..e23af011422db 100644 --- a/server/src-lib/Hasura/SQL/Value.hs +++ b/server/src-lib/Hasura/SQL/Value.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PatternSynonyms #-} module Hasura.SQL.Value where import Hasura.SQL.GeoJSON @@ -20,12 +21,36 @@ import qualified Data.Aeson.Types as AT import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL +import qualified Data.Vector as V import qualified Database.PostgreSQL.LibPQ as PQ import qualified PostgreSQL.Binary.Encoding as PE +import Foreign.C.Types + + +data PGColValue = PGColValue !PQ.Oid PGColValue' + deriving (Show, Eq) + +type PGElemOid = PQ.Oid + +data PGColValue' + = PGValBase !PGBaseColValue + | PGValDomain !PGColValue + | PGValArray !PGElemOid !(V.Vector PGColValue) + | PGValEnum !Text + | PGValRange !Text + -- TODO Change this to HashMap, field -> maybe PGColValue + | PGValComposite !Text + | PGNull + deriving (Show, Eq) -- Binary value. Used in prepared sq -data PGColValue +data PGBaseColValue + = PGValKnown !PGBCKnown + | PGValUnknown !T.Text + deriving (Show, Eq) + +data PGBCKnown = PGValInteger !Int32 | PGValSmallInt !Int16 | PGValBigInt !Int64 @@ -39,15 +64,49 @@ data PGColValue | PGValDate !Day | PGValTimeStampTZ !UTCTime | PGValTimeTZ !ZonedTimeOfDay - | PGNull !PGColType | PGValJSON !Q.JSON | PGValJSONB !Q.JSONB | PGValGeo !GeometryWithCRS - | PGValUnknown !T.Text deriving (Show, Eq) +data PGColValueBin = PGColValueBin PQ.Oid PGColValueBin' + +type ElemOid = PQ.Oid + +data PGColValueBin' + = PGValBaseBin !PGBCKnown + | PGValDomainBin !PGColValueBin + | PGValArrayBin ElemOid !(V.Vector PGColValueBin) + | PGNullBin + +toPGBinVal :: PGColValue -> Maybe PGColValueBin +toPGBinVal (PGColValue oid x) = fmap (PGColValueBin oid) $ case x of + PGNull -> Just PGNullBin + PGValComposite _ -> Nothing + PGValEnum _ -> Nothing + PGValDomain b -> fmap PGValDomainBin $ toPGBinVal b + PGValArray eOid v -> fmap (PGValArrayBin eOid) $ mapM toPGBinVal v + PGValBase b -> case b of + PGValKnown kb -> Just (PGValBaseBin kb) + PGValUnknown{} -> Nothing + +--binTyM :: PGColValue -> Maybe PGColValueBin +--binTyM + +txtEncoderG :: (PGBaseColValue -> S.SQLExp) -> PGColValue -> S.SQLExp +txtEncoderG f (PGColValue _ x) = case x of + PGValBase b -> f b + PGValDomain b -> txtEncoder b + PGValComposite a -> S.SELit a + PGValEnum a -> S.SELit a + PGValArray _ as -> S.SEArray $ map (txtEncoderG f) $ V.toList as + PGNull -> S.SEUnsafe "NULL" + txtEncoder :: PGColValue -> S.SQLExp -txtEncoder colVal = case colVal of +txtEncoder = txtEncoderG txtEncoder' + +txtEncoder' :: PGBaseColValue -> S.SQLExp +txtEncoder' (PGValKnown colVal) = case colVal of PGValInteger i -> S.SELit $ T.pack $ show i PGValSmallInt i -> S.SELit $ T.pack $ show i PGValBigInt i -> S.SELit $ T.pack $ show i @@ -63,114 +122,210 @@ txtEncoder colVal = case colVal of S.SELit $ T.pack $ formatTime defaultTimeLocale "%FT%T%QZ" u PGValTimeTZ (ZonedTimeOfDay tod tz) -> S.SELit $ T.pack (show tod ++ timeZoneOffsetString tz) - PGNull _ -> - S.SEUnsafe "NULL" + --PGNull _ -> + -- S.SEUnsafe "NULL" PGValJSON (Q.JSON j) -> S.SELit $ TL.toStrict $ AE.encodeToLazyText j PGValJSONB (Q.JSONB j) -> S.SELit $ TL.toStrict $ AE.encodeToLazyText j PGValGeo o -> S.SELit $ TL.toStrict $ AE.encodeToLazyText o - PGValUnknown t -> S.SELit t +txtEncoder' (PGValUnknown t) = S.SELit t -binEncoder :: PGColValue -> Q.PrepArg -binEncoder colVal = case colVal of - PGValInteger i -> - Q.toPrepVal i - PGValSmallInt i -> - Q.toPrepVal i - PGValBigInt i -> - Q.toPrepVal i - PGValFloat f -> - Q.toPrepVal f - PGValDouble d -> - Q.toPrepVal d - PGValNumeric sc -> - Q.toPrepVal sc - PGValBoolean b -> - Q.toPrepVal b - PGValChar t -> - Q.toPrepVal t - PGValVarchar t -> - Q.toPrepVal t - PGValText t -> - Q.toPrepVal t - PGValDate d -> - Q.toPrepVal d - PGValTimeStampTZ u -> - Q.toPrepVal u + +paTxtEncBase :: PGBCKnown -> (PQ.Oid, T.Text) +paTxtEncBase c = case c of + PGValInteger i -> (oidBuiltIn i, T.pack $ show i) + PGValSmallInt i -> (oidBuiltIn i, T.pack $ show i) + PGValBigInt i -> (oidBuiltIn i, T.pack $ show i) + PGValFloat i -> (oidBuiltIn i, T.pack $ show i) + PGValDouble i -> (oidBuiltIn i, T.pack $ show i) + PGValNumeric i -> (oidBuiltIn i, T.pack $ show i) + PGValBoolean i -> (oidBuiltIn i, T.pack $ show i) + PGValChar i -> (oidBuiltIn i, T.pack $ show i) + PGValVarchar t -> (oidBuiltIn t, t) + PGValText t -> (oidBuiltIn t, t) + PGValDate d -> (oidBuiltIn d, T.pack $ showGregorian d) + PGValTimeStampTZ i -> (oidBuiltIn i, T.pack $ show i) + PGValTimeTZ (ZonedTimeOfDay tod tz) -> + (PTI.timetz , T.pack (show tod ++ timeZoneOffsetString tz)) + PGValJSON t@(Q.JSON j) -> (oidBuiltIn t, TL.toStrict $ AE.encodeToLazyText j) + PGValJSONB t@(Q.JSONB j) -> (oidBuiltIn t, TL.toStrict $ AE.encodeToLazyText j) + PGValGeo o -> paTxtEncBase $ PGValText $ TL.toStrict $ AE.encodeToLazyText o + +data TxtEncInfo + = TxtEncInfo + { teiOid :: PQ.Oid + -- Should be double quoted if this encoding is for an element of array/composite etc + , teiToDoubleQuote :: Bool + , teiEnc :: Text + } + +paTxtEnc :: PGColValue -> TxtEncInfo +paTxtEnc (PGColValue oid v) = case v of + PGValBase (PGValKnown x) -> let y = paTxtEncBase x in TxtEncInfo (fst y) True (snd y) + PGValBase (PGValUnknown x) -> TxtEncInfo oid True $ T.pack $ show x + PGValDomain x -> paTxtEnc x + PGValComposite x -> TxtEncInfo oid True x + PGValEnum x -> TxtEncInfo oid True x + PGNull -> TxtEncInfo oid False "NULL" + PGValArray _ x -> TxtEncInfo oid True $ asPGArr $ V.toList x + where + asPGArr a = curly $ T.intercalate "," $ map encAndDoubleQuote a + encAndDoubleQuote x = + let TxtEncInfo _ q enc = paTxtEnc x in + bool id doubleQuoted q $ enc + doubleQuoted a = "\"" <> escaped a <> "\"" + escaped a = T.replace "\"" "\\\"" $ T.replace "\\" "\\\\" a + curly a = "{" <> a <> "}" + + +binEncKnown :: PGBCKnown -> (PQ.Oid, Maybe PE.Encoding) +binEncKnown c = case c of + PGValInteger i -> paBinEncBuiltIn i + PGValSmallInt i -> paBinEncBuiltIn i + PGValBigInt i -> paBinEncBuiltIn i + PGValFloat i -> paBinEncBuiltIn i + PGValDouble i -> paBinEncBuiltIn i + PGValNumeric i -> paBinEncBuiltIn i + PGValBoolean i -> paBinEncBuiltIn i + PGValChar t -> paBinEncBuiltIn t + PGValVarchar t -> paBinEncBuiltIn t + PGValText t -> paBinEncBuiltIn t + PGValDate d -> paBinEncBuiltIn d + PGValTimeStampTZ d -> paBinEncBuiltIn d PGValTimeTZ (ZonedTimeOfDay t z) -> - Q.toPrepValHelper PTI.timetz PE.timetz_int (t, z) - PGNull ty -> - (pgTypeOid ty, Nothing) - PGValJSON u -> - Q.toPrepVal u - PGValJSONB u -> - Q.toPrepVal u - PGValGeo o -> - Q.toPrepVal $ TL.toStrict $ AE.encodeToLazyText o - PGValUnknown t -> - (PTI.auto, Just (TE.encodeUtf8 t, PQ.Text)) - -parsePGValue' :: PGColType + (PTI.timetz , Just $ PE.timetz_int (t,z)) + PGValJSON u -> paBinEncBuiltIn u + PGValJSONB u -> paBinEncBuiltIn u + PGValGeo o -> paBinEncBuiltIn $ TL.toStrict $ AE.encodeToLazyText o + +binEnc :: PGColValueBin -> (PQ.Oid, Maybe PE.Encoding) +binEnc x@(PGColValueBin oid c) = case c of + PGNullBin -> (oid, Nothing) + PGValBaseBin b -> binEncKnown b + PGValDomainBin b -> binEnc b + PGValArrayBin elemOid _ -> (oid, Just $ PE.array (toWord32 elemOid) $ arrEnc x) + where + toWord32 (PQ.Oid (CUInt z)) = z + arrEnc :: PGColValueBin -> PE.Array + arrEnc (PGColValueBin _ z) = case z of + (PGValArrayBin _ y) -> PE.dimensionArray foldl' arrEnc y + PGNullBin -> PE.nullArray + PGValDomainBin b -> arrEnc b + PGValBaseBin t -> maybe PE.nullArray PE.encodingArray $ snd $ binEncKnown t + +paBinEncBuiltIn :: Q.BinaryEncBuiltInTy a => a -> (PQ.Oid, Maybe PE.Encoding) +paBinEncBuiltIn x = (o,encF x) + where (PTI.ElemOid o, _,encF) = Q.btBinaryEncInfo + +oidBuiltIn :: Q.BinaryEncBuiltInTy a => a -> PQ.Oid +oidBuiltIn = fst . paBinEncBuiltIn + +parseKnownValAs :: FromJSON a => (a -> PGBCKnown) -> Value -> AT.Parser PGBaseColValue +parseKnownValAs a v = PGValKnown . a <$> parseJSON v + +parsePGValue' :: PGBaseColType -> Value - -> AT.Parser PGColValue -parsePGValue' ty Null = - return $ PGNull ty + -> AT.Parser PGBaseColValue parsePGValue' PGSmallInt val = - PGValSmallInt <$> parseJSON val + parseKnownValAs PGValSmallInt val parsePGValue' PGInteger val = - PGValInteger <$> parseJSON val + parseKnownValAs PGValInteger val parsePGValue' PGBigInt val = - PGValBigInt <$> parseJSON val + parseKnownValAs PGValBigInt val parsePGValue' PGSerial val = - PGValInteger <$> parseJSON val + parseKnownValAs PGValInteger val parsePGValue' PGBigSerial val = - PGValBigInt <$> parseJSON val + parseKnownValAs PGValBigInt val parsePGValue' PGFloat val = - PGValFloat <$> parseJSON val + parseKnownValAs PGValFloat val parsePGValue' PGDouble val = - PGValDouble <$> parseJSON val + parseKnownValAs PGValDouble val parsePGValue' PGNumeric val = - PGValNumeric <$> parseJSON val + parseKnownValAs PGValNumeric val parsePGValue' PGBoolean val = - PGValBoolean <$> parseJSON val + parseKnownValAs PGValBoolean val parsePGValue' PGChar val = - PGValChar <$> parseJSON val + parseKnownValAs PGValChar val parsePGValue' PGVarchar val = - PGValVarchar <$> parseJSON val + parseKnownValAs PGValVarchar val parsePGValue' PGText val = - PGValText <$> parseJSON val + parseKnownValAs PGValText val parsePGValue' PGDate val = - PGValDate <$> parseJSON val + parseKnownValAs PGValDate val parsePGValue' PGTimeStampTZ val = - PGValTimeStampTZ <$> parseJSON val + parseKnownValAs PGValTimeStampTZ val parsePGValue' PGTimeTZ val = - PGValTimeTZ <$> parseJSON val + parseKnownValAs PGValTimeTZ val parsePGValue' PGJSON val = - PGValJSON . Q.JSON <$> parseJSON val + parseKnownValAs (PGValJSON . Q.JSON) val parsePGValue' PGJSONB val = - PGValJSONB . Q.JSONB <$> parseJSON val + parseKnownValAs (PGValJSONB . Q.JSONB) val parsePGValue' PGGeometry val = - PGValGeo <$> parseJSON val + parseKnownValAs PGValGeo val parsePGValue' PGGeography val = - PGValGeo <$> parseJSON val + parseKnownValAs PGValGeo val parsePGValue' (PGUnknown _) (String t) = return $ PGValUnknown t parsePGValue' (PGUnknown tyName) _ = fail $ "A string is expected for type : " ++ T.unpack tyName parsePGValue :: PGColType -> Value -> AT.Parser PGColValue -parsePGValue pct val = - case val of - String t -> parsePGValue' pct val <|> return (PGValUnknown t) - _ -> parsePGValue' pct val +parsePGValue pct Null = return $ PGColValue (pgColTyOid pct) PGNull +parsePGValue pct val = case pgColTyDetails pct of + PGTyPseudo{} -> fail "Column types do not return psuedo types" + PGTyArray pbct -> parseAsArray pbct val + PGTyEnum{} -> parseAsEnum val + PGTyDomain dom -> parsePGValue dom val + PGTyComposite{} -> parseAsComposite val + PGTyRange{} -> parseAsRange val + PGTyBase pbct -> case val of + String t -> parseAsBase pbct val <|> return (asUnknown pct t) + _ -> parseAsBase pbct val + where + parseAsVal :: (FromJSON a) => (a -> PGColValue') -> Value -> AT.Parser PGColValue + parseAsVal g v = + let oid = pgColTyOid pct + asVal = PGColValue oid . g in + fmap asVal $ parseJSON v + parseAsComposite = parseAsVal PGValComposite + parseAsEnum = parseAsVal PGValEnum + parseAsRange = parseAsVal PGValRange + parseAsArray bct v = (flip $ withArray "PGValArray (V.Vector PGColValue)") v $ \a -> do + let oid = pgColTyOid pct + eOid <- maybe (fail "Array types must return base element type") return $ getArrayBaseTy pct + let asArr = PGColValue oid . PGValArray (pgColTyOid eOid) + fmap asArr $ mapM (parsePGValue bct) a + + asUnknown bct v = PGColValue (pgColTyOid bct) $ PGValBase $ PGValUnknown v + + parseAsBase bct v = + let oid' = pgTypeOid bct + oidCol = pgColTyOid pct + -- For PGUnknown take oid from Column type + -- For PGKnown take from type of PGColValue + oid = bool oid' oidCol $ oid' == PTI.auto + asBaseColVal = PGColValue oid . PGValBase in + fmap asBaseColVal $ parsePGValue' bct v + convToBin :: PGColType -> Value -> AT.Parser Q.PrepArg -convToBin ty val = - binEncoder <$> parsePGValue ty val +convToBin ty val = do + colVal <- parsePGValue ty val + return $ binEncoder colVal + +binEncoder :: PGColValue -> Q.PrepArg +binEncoder colVal= maybe (asTxtPrepArg colVal) asBinPrepArg $ toPGBinVal colVal + where + asTxtPrepArg v + = let TxtEncInfo oid _ enc = paTxtEnc v in + (oid, Just (TE.encodeUtf8 enc, PQ.Text)) + asBinPrepArg vb + = let (oid, enc) = binEnc vb in + (oid, fmap (\x -> (PE.encodingBytes x,PQ.Binary)) enc ) convToTxt :: PGColType -> Value @@ -188,30 +343,54 @@ iresToEither (ISuccess a) = return a pgValFromJVal :: (FromJSON a) => Value -> Either String a pgValFromJVal = iresToEither . ifromJSON -withGeoVal :: PGColType -> S.SQLExp -> S.SQLExp -withGeoVal ty v = - bool v applyGeomFromGeoJson isGeoTy +pattern PGGeogVal :: GeometryWithCRS -> PGBaseColValue +pattern PGGeogVal x = PGValKnown (PGValGeo x) + + +txtEncWithGeoVal :: PGColValue -> S.SQLExp +txtEncWithGeoVal = txtEncoderG txtEncGeoJson where - applyGeomFromGeoJson = - S.SEFnApp "ST_GeomFromGeoJSON" [v] Nothing + txtEncGeoJson v = bool id applyGeomFromGeoJson (isGeoTy v) $ txtEncoder' v + + isGeoTy v = case v of + (PGGeogVal _) -> True + _ -> False - isGeoTy = case ty of - PGGeometry -> True - PGGeography -> True - _ -> False +applyGeomFromGeoJson :: S.SQLExp -> S.SQLExp +applyGeomFromGeoJson v = S.SEFnApp "ST_GeomFromGeoJSON" [v] Nothing toPrepParam :: Int -> PGColType -> S.SQLExp -toPrepParam i ty = - withGeoVal ty $ S.SEPrep i +toPrepParam i ty = withGeom ty $ S.SEPrep i + where + isGeoTy d = case d of + PGGeometry -> True + PGGeography -> True + _ -> False + --TODO : Change this to (select array_agg(ST_GeomFromGeoJSON(a) from unnest($1 :: ty[]) as a). Will work only for 1d array of Geometric types + applyArrGeomFromGeoJson = id + withGeom (PGColType _ _ _ d) = case d of + PGTyBase x -> bool id applyGeomFromGeoJson $ isGeoTy x + PGTyArray a -> case getArrayBaseTy a of + Just (PGColType _ _ _ (PGTyBase b)) -> bool id applyArrGeomFromGeoJson $ isGeoTy b + _ -> id + _ -> id toTxtValue :: PGColType -> PGColValue -> S.SQLExp toTxtValue ty val = S.annotateExp txtVal ty where - txtVal = withGeoVal ty $ txtEncoder val + txtVal = txtEncWithGeoVal val pgColValueToInt :: PGColValue -> Maybe Int -pgColValueToInt (PGValInteger i) = Just $ fromIntegral i -pgColValueToInt (PGValSmallInt i) = Just $ fromIntegral i -pgColValueToInt (PGValBigInt i) = Just $ fromIntegral i -pgColValueToInt _ = Nothing +pgColValueToInt (PGColValue _ x) = case x of + (PGValBase i) -> pgColValueToInt' i + (PGValDomain i) -> pgColValueToInt i + _ -> Nothing + +pgColValueToInt' :: PGBaseColValue -> Maybe Int +pgColValueToInt' (PGValUnknown{}) = Nothing +pgColValueToInt' (PGValKnown x) = case x of + (PGValInteger i) -> Just $ fromIntegral i + (PGValSmallInt i) -> Just $ fromIntegral i + (PGValBigInt i) -> Just $ fromIntegral i + _ -> Nothing diff --git a/server/src-rsr/pg_type_info.sql b/server/src-rsr/pg_type_info.sql new file mode 100644 index 0000000000000..fa2181bb22d88 --- /dev/null +++ b/server/src-rsr/pg_type_info.sql @@ -0,0 +1,70 @@ +select row_to_json(types) as types +from ( + select + t.oid :: integer as oid, + json_build_object( + 'name', + t.typname, + 'schema', + ns.nspname + ) as name, + pg_catalog.format_type(t.oid,NULL) as sql_name, + case + when arr_elem.oid is not null then + json_build_object( + 'type', + 'array', + 'elem_oid', + arr_elem.oid :: integer + ) + when t.typtype = 'b' then + json_build_object( + 'type', + 'base' + ) + when t.typtype = 'e' then + json_build_object( + 'type', + 'enum', + 'possible_values', + ( select array_agg(enumlabel order by enumsortorder) from pg_enum where enumtypid=t.oid ) + ) + + when t.typtype = 'c' then + json_build_object( + 'type', + 'composite', + 'fields', + ( select json_agg( ( select json_build_object( attname, ( select row_to_json(x) from (select atttypid :: integer as oid, attndims as dimension ) x ) ) ) ) from pg_attribute where attrelid = t.typrelid ) + ) + + when t.typtype = 'd' then + json_build_object( + 'type', + 'domain', + 'base_type', + json_build_object( + 'oid', + t.typbasetype:: integer, + 'dimension', + t.typndims + ) + ) + when t.typtype = 'p' then + json_build_object( + 'type', + 'pseudo' + ) + when t.typtype = 'r' then + json_build_object( + 'type', + 'range' + ) + else null + end as detail + from pg_type t + left outer join pg_namespace ns + on t.typnamespace = ns.oid + left outer join pg_type arr_elem + on t.oid = arr_elem.typarray + ) types diff --git a/server/src-rsr/table_info.sql b/server/src-rsr/table_info.sql index cf53f85c57cdd..487c9a8d6c5e2 100644 --- a/server/src-rsr/table_info.sql +++ b/server/src-rsr/table_info.sql @@ -14,13 +14,55 @@ from 'name', column_name, 'type', - udt_name, + json_build_object( + 'name', + json_build_object( + 'name', + ty.typname, + 'schema', + ty.typnamespace::regnamespace::text + ), + 'oid', + ty.oid :: int , + 'sqlName', + pg_catalog.format_type(td.atttypid, td.atttypmod), + 'dimension', + td.attndims + ), 'is_nullable', is_nullable :: boolean ) ) as columns from information_schema.columns c + left outer join ( + select pc.relnamespace, + pc.relname, + pa.attname, + pa.attndims, + pa.atttypid, + pa.atttypmod + from pg_attribute pa + left join pg_class pc + on pa.attrelid = pc.oid + ) td on + ( c.table_schema::regnamespace::oid = td.relnamespace + AND c.table_name = td.relname + AND c.column_name = td.attname + ) + left outer join pg_type ty + on + ( ty.typname = + case + when c.domain_name is not null then c.domain_name + else c.udt_name + end + AND ty.typnamespace::regnamespace::text = + case + when c.domain_name is not null then c.domain_schema + else c.udt_schema + end + ) group by c.table_schema, c.table_name diff --git a/server/stack.yaml b/server/stack.yaml index 7e275c8a067e7..b894b0d2919be 100644 --- a/server/stack.yaml +++ b/server/stack.yaml @@ -16,8 +16,8 @@ packages: # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) extra-deps: # use https URLs so that build systems can clone these repos -- git: https://github.com/hasura/pg-client-hs.git - commit: f3d1e9e67bdfbfa3de85b7cbdb4c557dce7fd84d +- git: https://github.com/nizar-m/pg-client-hs.git + commit: b9bf15a4bf3f61eaaff36f00cde68e4a0ac9b192 - git: https://github.com/hasura/graphql-parser-hs.git commit: ff95d9a96aa5ef9e5390f8712958e4118e3831f6 - ginger-0.8.1.0 From 8197844a2aa0eb6f9bcade79778b4c593502afee Mon Sep 17 00:00:00 2001 From: Nizar Malangadan Date: Tue, 12 Mar 2019 15:17:13 +0530 Subject: [PATCH 02/13] On Fields of InputObjects and Objects, add PGColTyAnnotation to help in parsing the type as ColumnType --- server/src-lib/Hasura/GraphQL/Context.hs | 23 +++--- .../src-lib/Hasura/GraphQL/Resolve/BoolExp.hs | 2 - .../Hasura/GraphQL/Resolve/InputValue.hs | 3 - .../Hasura/GraphQL/Resolve/Introspect.hs | 4 -- .../src-lib/Hasura/GraphQL/Resolve/Select.hs | 3 - server/src-lib/Hasura/GraphQL/Schema.hs | 22 +++--- server/src-lib/Hasura/GraphQL/Validate.hs | 1 - .../src-lib/Hasura/GraphQL/Validate/Field.hs | 4 +- .../Hasura/GraphQL/Validate/InputValue.hs | 31 ++++---- .../src-lib/Hasura/GraphQL/Validate/Types.hs | 34 +++++---- .../Hasura/RQL/DDL/Permission/Internal.hs | 7 +- server/src-lib/Hasura/RQL/DDL/Schema/Table.hs | 4 -- server/src-lib/Hasura/RQL/DML/Internal.hs | 25 ++++--- server/src-lib/Hasura/RQL/GBoolExp.hs | 9 +-- server/src-lib/Hasura/RQL/Types/Common.hs | 5 ++ server/src-lib/Hasura/SQL/Types.hs | 14 ++-- server/src-lib/Hasura/SQL/Value.hs | 71 +++++++++++++++---- 17 files changed, 157 insertions(+), 105 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Context.hs b/server/src-lib/Hasura/GraphQL/Context.hs index 2822319ef698c..1eb2158606d9e 100644 --- a/server/src-lib/Hasura/GraphQL/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Context.hs @@ -135,7 +135,7 @@ mkHsraObjFldInfo :: Maybe G.Description -> G.Name -> ParamMap - -> Maybe PGColType + -> Maybe PGColTyAnn -> G.GType -> ObjFldInfo mkHsraObjFldInfo descM name params pgTy ty = @@ -192,19 +192,18 @@ stDWithinInpTy = G.NamedType "st_d_within_input" --- | make compare expression input type --- TODO Nizar, how does _in comparison work with arrays mkCompExpInp :: PGColType -> InpObjTyInfo mkCompExpInp colTy@(PGColType _ _ _ colDtls) = InpObjTyInfo (Just tyDesc) (mkCompExpTy colTy) (fromInpValL $ concat - [ map (mk (Just colTy) colGQLTy) typedOps - -- TODO Nizar: Fix me , use an array of PGCol type here - , map (mk Nothing $ G.toLT colGQLTy) listOps - , bool [] (map (mk (Just $ baseBuiltInTy PGText) $ mkScalarBaseTy PGText) stringOps) isStringTy + [ map (mk (Just $ PTCol colTy) colGQLTy) typedOps + , map (mk (Just $ arrOfCol colTy) $ G.toLT colGQLTy) listOps + , bool [] (map (mk (Just $ PTCol $ baseBuiltInTy PGText) $ mkScalarBaseTy PGText) stringOps) isStringTy , bool [] (map jsonbOpToInpVal jsonbOps) isJsonbTy , bool [] (stDWithinOpInpVal : map geomOpToInpVal geomOps) isGeometryTy - , [InpValInfo Nothing "_is_null" Nothing (Just $ baseBuiltInTy PGBoolean) $ G.TypeNamed (G.Nullability True) $ G.NamedType "Boolean"] + , [InpValInfo Nothing "_is_null" Nothing (Just $ PTCol $ baseBuiltInTy PGBoolean) $ G.TypeNamed (G.Nullability True) $ G.NamedType "Boolean"] ]) HasuraType where + arrOfCol = PTArr . PTCol tyDesc = mconcat [ "expression to compare columns of type " , G.Description (T.pack $ show colTy) @@ -235,7 +234,7 @@ mkCompExpInp colTy@(PGColType _ _ _ colDtls) = isJsonbTy = case baseTy of Just PGJSONB -> True _ -> False - jsonbOpToInpVal (op, ty, desc) = InpValInfo (Just desc) op Nothing (Just $ baseBuiltInTy PGJSONB) ty + jsonbOpToInpVal (op, ty, desc) = InpValInfo (Just desc) op Nothing (Just $ PTCol $ baseBuiltInTy PGJSONB) ty jsonbOps = [ ( "_contains" , G.toGT $ mkScalarBaseTy PGJSONB @@ -261,7 +260,7 @@ mkCompExpInp colTy@(PGColType _ _ _ colDtls) = -- Geometry related ops stDWithinOpInpVal = - InpValInfo (Just stDWithinDesc) "_st_d_within" Nothing (Just $ baseBuiltInTy PGGeometry) $ G.toGT stDWithinInpTy + InpValInfo (Just stDWithinDesc) "_st_d_within" Nothing (Just $ PTCol $ baseBuiltInTy PGGeometry) $ G.toGT stDWithinInpTy stDWithinDesc = "is the column within a distance from a geometry value" @@ -270,7 +269,7 @@ mkCompExpInp colTy@(PGColType _ _ _ colDtls) = _ -> False geomOpToInpVal (op, desc) = - InpValInfo (Just desc) op Nothing (Just $ baseBuiltInTy PGGeometry) $ G.toGT $ mkScalarBaseTy PGGeometry + InpValInfo (Just desc) op Nothing (Just $ PTCol $ baseBuiltInTy PGGeometry) $ G.toGT $ mkScalarBaseTy PGGeometry geomOps = [ ( "_st_contains" @@ -377,8 +376,8 @@ mkGCtx tyAgg (RootFlds flds) insCtxMap = stDWithinInpM = bool Nothing (Just stDWithinInp) (PGTyBase PGGeometry `elem` map pgColTyDetails colTys) stDWithinInp = mkHsraInpTyInfo Nothing stDWithinInpTy $ fromInpValL - [ InpValInfo Nothing "from" Nothing (Just $ baseBuiltInTy PGGeometry) $ G.toGT $ G.toNT $ mkScalarBaseTy PGGeometry - , InpValInfo Nothing "distance" Nothing (Just $ baseBuiltInTy PGGeometry) $ G.toNT $ G.toNT $ mkScalarBaseTy PGFloat + [ InpValInfo Nothing "from" Nothing (Just $ PTCol $ baseBuiltInTy PGGeometry) $ G.toGT $ G.toNT $ mkScalarBaseTy PGGeometry + , InpValInfo Nothing "distance" Nothing (Just $ PTCol $ baseBuiltInTy PGGeometry) $ G.toNT $ G.toNT $ mkScalarBaseTy PGFloat ] emptyGCtx :: GCtx diff --git a/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs b/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs index 0309fcdd61037..c7afc9a1e0380 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE PatternSynonyms #-} module Hasura.GraphQL.Resolve.BoolExp ( parseBoolExp , pgColValToBoolExp @@ -21,7 +20,6 @@ import Hasura.SQL.Value type OpExp = OpExpG (PGColType, PGColValue) -pattern PGBoolVal o b = PGColValue o (PGValBase (PGValKnown (PGValBoolean b))) parseOpExps :: (MonadError QErr m) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs b/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs index 054e6d17195e3..ecf401fcef00c 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE PatternSynonyms #-} module Hasura.GraphQL.Resolve.InputValue ( withNotNull , tyMismatch @@ -122,8 +121,6 @@ parseMany fn v = case v of AGArray _ arrM -> mapM (mapM fn) arrM _ -> tyMismatch "array" v -pattern PGTxtVal o x = PGColValue o (PGValBase (PGValKnown (PGValText x))) - asPGColText :: (MonadError QErr m) => AnnGValue -> m Text diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs b/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs index 4ae911d311539..f2dd4a6e6b93c 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE PatternSynonyms #-} module Hasura.GraphQL.Resolve.Introspect ( schemaR , typeR @@ -262,7 +261,6 @@ inputValueR fld (InpValInfo descM n defM _ ty) = "name" -> retJ $ G.unName n "description" -> retJ $ fmap G.unDescription descM "type" -> J.toJSON <$> gtypeR ty subFld - -- TODO: figure out what the spec means by 'string encoding' "defaultValue" -> retJ $ pPrintValueC <$> defM _ -> return J.Null @@ -329,8 +327,6 @@ schemaR fld = (sortBy (comparing _diName) defaultDirectives) _ -> return J.Null -pattern PGTxtVal o t = PGColValue o (PGValBase (PGValKnown (PGValText t))) - typeR :: ( MonadReader r m, Has TypeMap r , MonadError QErr m) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs index 8139bdacb5a85..cafa7a17b2205 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE PatternSynonyms #-} module Hasura.GraphQL.Resolve.Select ( convertSelect , convertSelectByPKey @@ -287,8 +286,6 @@ parseColumns val = (_, enumVal) <- asEnumVal v return $ PGCol $ G.unName $ G.unEnumValue enumVal -pattern PGBoolVal o b = PGColValue o (PGValBase (PGValKnown (PGValBoolean b))) - convertCount :: MonadError QErr m => ArgsMap -> m S.CountType convertCount args = do columnsM <- withArgM args "columns" parseColumns diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index fdec65d1934d3..cb68933c77c39 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -170,7 +170,7 @@ mkTableByPkName tn = qualObjectToName tn <> "_by_pk" mkPGColFld :: PGColInfo -> ObjFldInfo mkPGColFld (PGColInfo colName colTy isNullable) = - mkHsraObjFldInfo Nothing n Map.empty (Just colTy) ty + mkHsraObjFldInfo Nothing n Map.empty (Just $ PTCol colTy) ty where n = G.Name $ getPGColTxt colName ty = bool notNullTy nullTy isNullable @@ -322,13 +322,13 @@ mkTableAggFldsObj tn numCols compCols = desc = G.Description $ "aggregate fields of " <>> tn - countFld = mkHsraObjFldInfo Nothing "count" countParams (Just $ baseBuiltInTy PGInteger) $ G.toGT $ mkScalarBaseTy PGInteger + countFld = mkHsraObjFldInfo Nothing "count" countParams (Just $ PTCol $ baseBuiltInTy PGInteger) $ G.toGT $ mkScalarBaseTy PGInteger countParams = fromInpValL [countColInpVal, distinctInpVal] countColInpVal = InpValInfo Nothing "columns" Nothing Nothing $ G.toGT $ G.toLT $ G.toNT $ mkSelColumnInpTy tn - distinctInpVal = InpValInfo Nothing "distinct" Nothing (Just $ baseBuiltInTy PGBoolean) $ G.toGT $ mkScalarBaseTy PGBoolean + distinctInpVal = InpValInfo Nothing "distinct" Nothing (Just $ PTCol $ baseBuiltInTy PGBoolean) $ G.toGT $ mkScalarBaseTy PGBoolean numFlds = bool (map mkColOpFld numAggOps) [] $ null numCols compFlds = bool (map mkColOpFld compAggOps) [] $ null compCols @@ -357,7 +357,7 @@ mkTableColAggFldsObj tn op f cols = mkColObjFld c = let colTy = pgiType c in mkHsraObjFldInfo Nothing (G.Name $ getPGColTxt $ pgiName c) - Map.empty (Just colTy) $ G.toGT $ f colTy + Map.empty (Just $ PTCol colTy) $ G.toGT $ f colTy {- @@ -399,7 +399,7 @@ mkSelFldPKey tn cols = args = fromInpValL $ map colInpVal cols ty = G.toGT $ mkTableTy tn colInpVal (PGColInfo n typ _) = - InpValInfo Nothing (mkColName n) Nothing (Just typ) $ G.toGT $ G.toNT $ mkScalarTy typ + InpValInfo Nothing (mkColName n) Nothing (Just $ PTCol typ) $ G.toGT $ G.toNT $ mkScalarTy typ {- @@ -511,7 +511,7 @@ mkMutRespObj tn sel nestAlwd = objDesc = G.Description $ "response of any mutation on the table " <>> tn affectedRowsFld = - mkHsraObjFldInfo (Just desc) "affected_rows" Map.empty (Just $ baseBuiltInTy PGInteger) $ + mkHsraObjFldInfo (Just desc) "affected_rows" Map.empty (Just $ PTCol $ baseBuiltInTy PGInteger) $ G.toGT $ G.toNT $ mkScalarBaseTy PGInteger where desc = "number of affected rows by the mutation" @@ -560,7 +560,7 @@ mkBoolExpInp tn fields = mkPGColInp :: PGColInfo -> InpValInfo mkPGColInp (PGColInfo colName colTy _) = - InpValInfo Nothing (G.Name $ getPGColTxt colName) Nothing (Just colTy) $ + InpValInfo Nothing (G.Name $ getPGColTxt colName) Nothing (Just $ PTCol colTy) $ mkPGColGTy colTy --G.toGT $ mkScalarTy colTy @@ -602,7 +602,7 @@ mkFuncArgsInp funcInfo = argInps = procFuncArgs funcArgs mkInpVal mkInpVal ty t = - InpValInfo Nothing (G.Name t) Nothing (Just ty) $ G.toGT $ + InpValInfo Nothing (G.Name t) Nothing (Just $ PTCol ty) $ G.toGT $ G.toNT $ mkPGColGTy ty -- table_set_input @@ -752,19 +752,19 @@ mkUpdJSONOpInp tn cols = bool inpObjs [] $ null jsonbCols deleteKeyInpObj = mkHsraInpTyInfo (Just deleteKeyDesc) (mkJSONOpTy tn deleteKeyOp) $ fromInpValL $ map deleteKeyInpVal jsonbColNames - deleteKeyInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ baseBuiltInTy PGText) $ + deleteKeyInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ PTCol $ baseBuiltInTy PGText) $ G.toGT $ G.NamedType "String" deleteElemInpObj = mkHsraInpTyInfo (Just deleteElemDesc) (mkJSONOpTy tn deleteElemOp) $ fromInpValL $ map deleteElemInpVal jsonbColNames - deleteElemInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ baseBuiltInTy PGInteger) $ + deleteElemInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ PTCol $ baseBuiltInTy PGInteger) $ G.toGT $ G.NamedType "Int" deleteAtPathInpObj = mkHsraInpTyInfo (Just deleteAtPathDesc) (mkJSONOpTy tn deleteAtPathOp) $ fromInpValL $ map deleteAtPathInpVal jsonbColNames - deleteAtPathInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ baseBuiltInTy PGText) $ + deleteAtPathInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ PTCol $ baseBuiltInTy PGText) $ G.toGT $ G.toLT $ G.NamedType "String" {- diff --git a/server/src-lib/Hasura/GraphQL/Validate.hs b/server/src-lib/Hasura/GraphQL/Validate.hs index 94edec9995a1c..1ceab604a9ec7 100644 --- a/server/src-lib/Hasura/GraphQL/Validate.hs +++ b/server/src-lib/Hasura/GraphQL/Validate.hs @@ -16,7 +16,6 @@ import Hasura.GraphQL.Schema import Hasura.GraphQL.Transport.HTTP.Protocol import Hasura.GraphQL.Validate.Context import Hasura.GraphQL.Validate.Field -import Hasura.GraphQL.Validate.InputValue import Hasura.GraphQL.Validate.Types import Hasura.RQL.Types diff --git a/server/src-lib/Hasura/GraphQL/Validate/Field.hs b/server/src-lib/Hasura/GraphQL/Validate/Field.hs index d6522eb7a9593..82e9565dd5481 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Field.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Field.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE PatternSynonyms #-} module Hasura.GraphQL.Validate.Field ( ArgsMap , Field(..) @@ -110,7 +109,6 @@ data FieldGroup -- throwGE :: (MonadError QErr m) => Text -> m a -- throwGE msg = throwError $ QErr msg [] -pattern PGBoolVal o b <- PGColValue o (PGValBase (PGValKnown (PGValBoolean b))) withDirectives :: ( MonadReader ValidationCtx m @@ -186,7 +184,7 @@ processArgs fldParams argsL = do inpArgs <- forM args $ \(G.Argument argName argVal) -> withPathK (G.unName argName) $ do argTy <- getArgTy argName - validateInputValue (valueParser $ _iviPGTy argTy) (_iviType argTy) (_iviPGTy argTy) argVal + validateInputValue (valueParser $ _iviPGTyAnn argTy) (_iviType argTy) (_iviPGTyAnn argTy) argVal forM_ requiredParams $ \argDef -> do let param = _iviName argDef diff --git a/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs b/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs index 6db757483697c..70de412b4747e 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs @@ -20,7 +20,6 @@ import qualified Data.Vector as V import qualified Language.GraphQL.Draft.Syntax as G import Hasura.GraphQL.Utils -import Hasura.SQL.Types import Hasura.GraphQL.Validate.Context import Hasura.GraphQL.Validate.Types import Hasura.RQL.Types @@ -37,7 +36,7 @@ pVal = return . P . Just . Right resolveVar :: ( MonadError QErr m , MonadReader ValidationCtx m) - => Maybe PGColType -> G.Variable -> m AnnGValue + => Maybe PGColTyAnn -> G.Variable -> m AnnGValue resolveVar pgTy var = do varVals <- _vcVarVals <$> ask -- TODO typecheck @@ -62,7 +61,7 @@ resolveVar pgTy var = do pVar :: ( MonadError QErr m , MonadReader ValidationCtx m) - => Maybe PGColType -> G.Variable -> m (P a) + => Maybe PGColTyAnn -> G.Variable -> m (P a) pVar pgTy var = do annInpVal <- resolveVar pgTy var return . P . Just . Left $ annInpVal @@ -114,7 +113,7 @@ toJValue = \case valueParser :: ( MonadError QErr m , MonadReader ValidationCtx m) - => Maybe PGColType -> InputValueParser G.Value m + => Maybe PGColTyAnn -> InputValueParser G.Value m valueParser pgTy = InputValueParser pScalar pList pObject pEnum where @@ -228,7 +227,7 @@ validateObject valParser tyInfo flds = do fmap OMap.fromList $ forM flds $ \(fldName, fldVal) -> withPathK (G.unName fldName) $ do fldInfo <- getInpFieldInfo tyInfo fldName - convFldVal <- validateInputValue valParser (_iviType fldInfo) (_iviPGTy fldInfo) fldVal + convFldVal <- validateInputValue valParser (_iviType fldInfo) (_iviPGTyAnn fldInfo) fldVal return (fldName, convFldVal) where @@ -273,13 +272,14 @@ validateList :: (MonadError QErr m, MonadReader r m, Has TypeMap r) => InputValueParser a m -> G.ListType + -> Maybe PGColTyAnn -> a -> m AnnGValue -validateList inpValParser listTy val = +validateList inpValParser listTy pgTyAnn val = withParsed (getList inpValParser) val $ \lM -> do let baseTy = G.unListType listTy AGArray listTy <$> - mapM (indexedMapM (validateInputValue inpValParser baseTy Nothing)) lM + mapM (indexedMapM (validateInputValue inpValParser baseTy pgTyAnn)) lM -- validateNonNull -- :: (MonadError QErr m, MonadReader r m, Has TypeMap r) @@ -299,16 +299,23 @@ validateInputValue :: (MonadError QErr m, MonadReader r m, Has TypeMap r) => InputValueParser a m -> G.GType - -> Maybe PGColType + -> Maybe PGColTyAnn -> a -> m AnnGValue validateInputValue inpValParser ty Nothing val = case ty of G.TypeNamed _ nt -> validateNamedTypeVal inpValParser nt val - G.TypeList _ lt -> validateList inpValParser lt val -validateInputValue inpValParser _ (Just pgColTy) val = - withParsed (getScalar inpValParser) val $ - fmap (AGPGVal pgColTy) . mapM (validatePGVal pgColTy) + G.TypeList _ lt -> validateList inpValParser lt Nothing val +validateInputValue inpValParser ty (Just pgTyAnn) val = + case (pgTyAnn,ty) of + (PTCol colTy,_) -> + withParsed (getScalar inpValParser) val $ + fmap (AGPGVal colTy) . mapM (validatePGVal colTy) + (PTArr pgElemTyAnn,G.TypeList _ lt) -> + validateList inpValParser lt (Just pgElemTyAnn) val + _ -> + throw500 $ "Invalid Postgres column type annotation " <> T.pack (show pgTyAnn) + <> " for GraphQL type " <> T.pack (show ty) where validatePGVal pct = runAesonParser (parsePGValue pct) withParsed diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index cc17299ec3132..2e8dcbe856215 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -50,6 +50,7 @@ module Hasura.GraphQL.Validate.Types , getAnnInpValKind , getAnnInpValTy , GQLColTyMap + , PGColTyAnn(..) , module Hasura.GraphQL.Utils ) where @@ -110,13 +111,18 @@ fromEnumTyDef (G.EnumTypeDefinition descM n _ valDefs) loc = enumVals = Map.fromList [(G._evdName valDef, fromEnumValDef valDef) | valDef <- valDefs] +data PGColTyAnn + = PTCol PGColType + | PTArr PGColTyAnn + deriving (Show, Eq, TH.Lift) + data InpValInfo = InpValInfo - { _iviDesc :: !(Maybe G.Description) - , _iviName :: !G.Name - , _iviDefVal :: !(Maybe G.ValueConst) - , _iviPGTy :: !(Maybe PGColType) - , _iviType :: !G.GType + { _iviDesc :: !(Maybe G.Description) + , _iviName :: !G.Name + , _iviDefVal :: !(Maybe G.ValueConst) + , _iviPGTyAnn :: !(Maybe PGColTyAnn) + , _iviType :: !G.GType } deriving (Show, Eq, TH.Lift) instance EquatableGType InpValInfo where @@ -126,7 +132,7 @@ instance EquatableGType InpValInfo where fromInpValDef :: G.InputValueDefinition -> GQLColTyMap -> InpValInfo fromInpValDef (G.InputValueDefinition descM n ty defM) gctm = InpValInfo descM n defM pgTy ty - where pgTy = Map.lookup (getBaseTy ty, getArrDim ty) gctm + where pgTy = fmap PTCol $ Map.lookup (getBaseTy ty, getArrDim ty) gctm type ParamMap = Map.HashMap G.Name InpValInfo @@ -140,12 +146,12 @@ instance Hashable TypeLoc data ObjFldInfo = ObjFldInfo - { _fiDesc :: !(Maybe G.Description) - , _fiName :: !G.Name - , _fiParams :: !ParamMap - , _fiPGTy :: !(Maybe PGColType) - , _fiTy :: !G.GType - , _fiLoc :: !TypeLoc + { _fiDesc :: !(Maybe G.Description) + , _fiName :: !G.Name + , _fiParams :: !ParamMap + , _fiPGTyAnn :: !(Maybe PGColTyAnn) + , _fiTy :: !G.GType + , _fiLoc :: !TypeLoc } deriving (Show, Eq, TH.Lift) instance EquatableGType ObjFldInfo where @@ -157,7 +163,7 @@ fromFldDef (G.FieldDefinition descM n args ty _) gctm loc = ObjFldInfo descM n params pgTy ty loc where params = Map.fromList [(G._ivdName arg, fromInpValDef arg gctm) | arg <- args] - pgTy = Map.lookup (getBaseTy ty, getArrDim ty) gctm + pgTy = fmap PTCol $ Map.lookup (getBaseTy ty, getArrDim ty) gctm type ObjFieldMap = Map.HashMap G.Name ObjFldInfo @@ -617,7 +623,7 @@ defaultDirectives = where mkDirective n = DirectiveInfo Nothing n args dirLocs args = Map.singleton "if" $ InpValInfo Nothing "if" Nothing - (Just $ baseBuiltInTy PGBoolean) $ + (Just $ PTCol $ baseBuiltInTy PGBoolean) $ G.TypeNamed (G.Nullability False) $ G.NamedType $ G.Name "Boolean" dirLocs = map G.DLExecutable [G.EDLFIELD, G.EDLFRAGMENT_SPREAD, G.EDLINLINE_FRAGMENT] diff --git a/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs b/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs index 26bb56165e005..c2d5be8bfe4d5 100644 --- a/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs +++ b/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs @@ -21,7 +21,7 @@ import Hasura.RQL.GBoolExp import Hasura.RQL.Types import Hasura.Server.Utils import Hasura.SQL.Types -import Hasura.SQL.Value (txtEncWithGeoVal) +import Hasura.SQL.Value (withGeom) import qualified Database.PG.Query as Q import qualified Hasura.SQL.DML as S @@ -213,10 +213,9 @@ valueParser columnType = \case val -> txtRHSBuilder columnType val where curSess = S.SEUnsafe "current_setting('hasura.user')::json" - --TODO Nizar, Put the correct modification here - fromCurSess hdr = withAnnTy $ id $ + fromCurSess hdr = withAnnTy $ withGeom columnType $ S.SEOpApp (S.SQLOp "->>") [curSess, S.SELit $ T.toLower hdr] - withAnnTy v = S.SETyAnn v $ AnnType $ T.pack $ show columnType + withAnnTy v = S.SETyAnn v $ pgColTySqlName columnType injectDefaults :: QualifiedTable -> QualifiedTable -> Q.Query injectDefaults qv qt = diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs index 07c814b0255ee..4bf1a8fd98c51 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs @@ -29,7 +29,6 @@ import Language.Haskell.TH.Syntax (Lift) import Network.URI.Extended () import qualified Data.HashMap.Strict as M -import qualified Data.HashSet as S import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Database.PostgreSQL.LibPQ as PQ @@ -77,9 +76,6 @@ toPGColTypes cols' = do return $ flip map pgTysMap $ \(PGColInfo' na _ nu,pgColTy) -> PGColInfo na pgColTy nu where - toColInfo (PGColInfo' na t nu) f = PGColInfo na (f t) nu - toColTy ci' typesMap = onNothing (M.lookup ci' typesMap) $ throw500 $ - "Could not find Postgres type with oid " <> T.pack (show $ pcoiOid ci') newtype TrackTable = TrackTable diff --git a/server/src-lib/Hasura/RQL/DML/Internal.hs b/server/src-lib/Hasura/RQL/DML/Internal.hs index eec1cad5fcf24..936c39185894a 100644 --- a/server/src-lib/Hasura/RQL/DML/Internal.hs +++ b/server/src-lib/Hasura/RQL/DML/Internal.hs @@ -226,18 +226,27 @@ dmlTxErrorHandler p2Res = toJSONableExp :: Bool -> PGColType -> S.SQLExp -> S.SQLExp toJSONableExp strfyNum colTy expn = case pgColTyDetails colTy of PGTyBase b -> toJSONableExp' strfyNum b expn - --TODO Handle the case with an array of geometry types - _ -> expn + PGTyArray {} -> maybe expn (\ty -> toJSONableArrExp strfyNum ty expn) $ getArrayBaseTy colTy + _ -> expn + +toJSONableArrExp :: Bool -> PGColType -> S.SQLExp -> S.SQLExp +toJSONableArrExp strfyNum bcolTy expn = case pgColTyDetails bcolTy of + PGTyBase b -> toJSONableArrExp' strfyNum b expn + PGTyDomain b -> toJSONableExp strfyNum b expn + _ -> expn + +toJSONableArrExp' :: Bool -> PGBaseColType -> S.SQLExp -> S.SQLExp +toJSONableArrExp' strfyNum bColTy expn + | bColTy == PGGeometry || bColTy == PGGeography = + applyAsGeoJSONArr expn `S.SETyAnn` jsonArrType + | isBigNum' bColTy && strfyNum = + expn `S.SETyAnn` textArrType + | otherwise = expn toJSONableExp' :: Bool -> PGBaseColType -> S.SQLExp -> S.SQLExp toJSONableExp' strfyNum colTy expn | colTy == PGGeometry || colTy == PGGeography = - S.SEFnApp "ST_AsGeoJSON" - [ expn - , S.SEUnsafe "15" -- max decimal digits - , S.SEUnsafe "4" -- to print out crs - ] Nothing - `S.SETyAnn` jsonType + applyAsGeoJSON expn | isBigNum' colTy && strfyNum = expn `S.SETyAnn` textType | otherwise = expn diff --git a/server/src-lib/Hasura/RQL/GBoolExp.hs b/server/src-lib/Hasura/RQL/GBoolExp.hs index ac8f1f1927926..5d63ee01e381b 100644 --- a/server/src-lib/Hasura/RQL/GBoolExp.hs +++ b/server/src-lib/Hasura/RQL/GBoolExp.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE PatternSynonyms #-} module Hasura.RQL.GBoolExp ( toSQLBoolExp , getBoolExpDeps @@ -19,7 +18,6 @@ import Data.Aeson import qualified Data.HashMap.Strict as M import qualified Data.Text.Extended as T -pattern PGGeomTy a b c = PGColType a b c (PGTyBase PGGeometry) parseOpExp :: (MonadError QErr m) @@ -216,13 +214,14 @@ buildMsg ty expTys = , T.intercalate "/" $ map (T.dquote . T.pack . show) expTys ] +textOnlyOp :: MonadError QErr m => PGColType -> m () textOnlyOp colTy = case pgColTyDetails colTy of PGTyBase b -> textOnlyOp' b _ -> onlyTxtTyErr where textOnlyOp' PGText = return () textOnlyOp' PGVarchar = return () - textOnlyOp' ty = onlyTxtTyErr + textOnlyOp' _ = onlyTxtTyErr onlyTxtTyErr = throwError $ buildMsg colTy $ baseBuiltInTy <$> [PGVarchar, PGText] -- This convoluted expression instead of col = val @@ -250,8 +249,6 @@ annBoolExp annBoolExp valParser fim (BoolExp boolExp) = traverse (annColExp valParser fim) boolExp -pattern JSONCol a b x y z = PGColInfo a (PGColType x y z (PGTyBase PGJSON)) b - annColExp :: (QErrM m, CacheRM m) => ValueParser m a @@ -261,7 +258,7 @@ annColExp annColExp valueParser colInfoMap (ColExp fieldName colVal) = do colInfo <- askFieldInfo colInfoMap fieldName case colInfo of - FIColumn (JSONCol{}) -> + FIColumn (JSONColInfo{}) -> throwError (err400 UnexpectedPayload "JSON column can not be part of where clause") -- FIColumn (PGColInfo _ PGJSONB _) -> -- throwError (err400 UnexpectedPayload "JSONB column can not be part of where clause") diff --git a/server/src-lib/Hasura/RQL/Types/Common.hs b/server/src-lib/Hasura/RQL/Types/Common.hs index 0a99c973df142..e5fa458cf0b7f 100644 --- a/server/src-lib/Hasura/RQL/Types/Common.hs +++ b/server/src-lib/Hasura/RQL/Types/Common.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE PatternSynonyms #-} module Hasura.RQL.Types.Common ( PGColInfo(..) + , PGColInfo(JSONColInfo) , RelName(..) , RelType(..) , relTypeToTxt @@ -130,6 +132,9 @@ data PGColInfo $(deriveJSON (aesonDrop 3 snakeCase) ''PGColInfo) +pattern JSONColInfo :: PGCol -> Bool -> QualifiedType -> AnnType -> PQ.Oid -> PGColInfo +pattern JSONColInfo a b x y z = PGColInfo a (PGColType x y z (PGTyBase PGJSON)) b + newtype RelName = RelName {getRelTxt :: T.Text} deriving (Show, Eq, Hashable, FromJSON, ToJSON, Q.ToPrepArg, Q.FromCol, Lift) diff --git a/server/src-lib/Hasura/SQL/Types.hs b/server/src-lib/Hasura/SQL/Types.hs index e8242b5259f38..1206829daa348 100644 --- a/server/src-lib/Hasura/SQL/Types.hs +++ b/server/src-lib/Hasura/SQL/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE PatternSynonyms #-} module Hasura.SQL.Types where import qualified Database.PG.Query as Q @@ -268,6 +269,9 @@ textArrType = AnnType "text[]" jsonType :: AnnType jsonType = AnnType "json" +jsonArrType :: AnnType +jsonArrType = AnnType "json[]" + jsonbType :: AnnType jsonbType = AnnType "jsonb" @@ -467,6 +471,12 @@ isNumType = onBaseUDT False isNumType' isJSONBType :: PGColType -> Bool isJSONBType = onBaseUDT False isJSONBType' +pattern PGGeomTy :: QualifiedType -> AnnType -> PQ.Oid -> PGColType +pattern PGGeomTy a b c = PGColType a b c (PGTyBase PGGeometry) + +pattern PGJSONTy :: QualifiedType -> AnnType -> PQ.Oid -> PGColType +pattern PGJSONTy a b c = PGColType a b c (PGTyBase PGJSON) + --any numeric, string, date/time, network, or enum type, or arrays of these types isComparableType :: PGColType -> Bool isComparableType t = case pgColTyDetails t of @@ -508,10 +518,6 @@ isComparableType' PGBoolean = False isComparableType' (PGUnknown _) = False isComparableType' _ = True ---TODO Nizar, Check how to handle array of BigNum -isBigNum :: PGColType -> Bool -isBigNum = onBaseUDT False isBigNum' - isBigNum' :: PGBaseColType -> Bool isBigNum' = \case PGBigInt -> True diff --git a/server/src-lib/Hasura/SQL/Value.hs b/server/src-lib/Hasura/SQL/Value.hs index c4f9abb9e9006..c6c475294f645 100644 --- a/server/src-lib/Hasura/SQL/Value.hs +++ b/server/src-lib/Hasura/SQL/Value.hs @@ -14,6 +14,7 @@ import Data.Aeson.Internal import Data.Int import Data.Scientific import Data.Time +import Foreign.C.Types import Hasura.Prelude import qualified Data.Aeson.Text as AE @@ -25,7 +26,6 @@ import qualified Data.Vector as V import qualified Database.PostgreSQL.LibPQ as PQ import qualified PostgreSQL.Binary.Encoding as PE -import Foreign.C.Types data PGColValue = PGColValue !PQ.Oid PGColValue' @@ -33,6 +33,12 @@ data PGColValue = PGColValue !PQ.Oid PGColValue' type PGElemOid = PQ.Oid +pattern PGBoolVal :: PQ.Oid -> Bool -> PGColValue +pattern PGBoolVal o b <- PGColValue o (PGValBase (PGValKnown (PGValBoolean b))) + +pattern PGTxtVal :: PQ.Oid -> Text -> PGColValue +pattern PGTxtVal o x = PGColValue o (PGValBase (PGValKnown (PGValText x))) + data PGColValue' = PGValBase !PGBaseColValue | PGValDomain !PGColValue @@ -83,11 +89,12 @@ toPGBinVal :: PGColValue -> Maybe PGColValueBin toPGBinVal (PGColValue oid x) = fmap (PGColValueBin oid) $ case x of PGNull -> Just PGNullBin PGValComposite _ -> Nothing + PGValRange _ -> Nothing PGValEnum _ -> Nothing PGValDomain b -> fmap PGValDomainBin $ toPGBinVal b PGValArray eOid v -> fmap (PGValArrayBin eOid) $ mapM toPGBinVal v PGValBase b -> case b of - PGValKnown kb -> Just (PGValBaseBin kb) + PGValKnown kb -> Just (PGValBaseBin kb) PGValUnknown{} -> Nothing --binTyM :: PGColValue -> Maybe PGColValueBin @@ -98,6 +105,7 @@ txtEncoderG f (PGColValue _ x) = case x of PGValBase b -> f b PGValDomain b -> txtEncoder b PGValComposite a -> S.SELit a + PGValRange a -> S.SELit a PGValEnum a -> S.SELit a PGValArray _ as -> S.SEArray $ map (txtEncoderG f) $ V.toList as PGNull -> S.SEUnsafe "NULL" @@ -155,10 +163,10 @@ paTxtEncBase c = case c of data TxtEncInfo = TxtEncInfo - { teiOid :: PQ.Oid + { teiOid :: PQ.Oid -- Should be double quoted if this encoding is for an element of array/composite etc - , teiToDoubleQuote :: Bool - , teiEnc :: Text + , teiToDoubleQuote :: Bool + , teiEnc :: Text } paTxtEnc :: PGColValue -> TxtEncInfo @@ -167,6 +175,7 @@ paTxtEnc (PGColValue oid v) = case v of PGValBase (PGValUnknown x) -> TxtEncInfo oid True $ T.pack $ show x PGValDomain x -> paTxtEnc x PGValComposite x -> TxtEncInfo oid True x + PGValRange x -> TxtEncInfo oid True x PGValEnum x -> TxtEncInfo oid True x PGNull -> TxtEncInfo oid False "NULL" PGValArray _ x -> TxtEncInfo oid True $ asPGArr $ V.toList x @@ -359,21 +368,55 @@ txtEncWithGeoVal = txtEncoderG txtEncGeoJson applyGeomFromGeoJson :: S.SQLExp -> S.SQLExp applyGeomFromGeoJson v = S.SEFnApp "ST_GeomFromGeoJSON" [v] Nothing +applyAsGeoJSON :: S.SQLExp -> S.SQLExp +applyAsGeoJSON expn = + S.SEFnApp "ST_AsGeoJSON" + [ expn + , S.SEUnsafe "15" -- max decimal digits + , S.SEUnsafe "4" -- to print out crs + ] Nothing + `S.SETyAnn` jsonType + +applyAsGeoJSONArr :: S.SQLExp -> S.SQLExp +applyAsGeoJSONArr v = + S.SESelect S.mkSelect + { S.selExtr = + [ flip S.Extractor Nothing $ S.SEFnApp "array_agg" [applyAsGeoJSON $ S.SEIden $ toIden unnestF] Nothing + ] + , S.selFrom = Just $ S.FromExp [S.mkFuncFromItem qualUnnestF [v]] + } `S.SETyAnn` jsonArrType + where + qualUnnestF = QualifiedObject catalogSchema unnestF + unnestF = FunctionName "unnest" + toPrepParam :: Int -> PGColType -> S.SQLExp toPrepParam i ty = withGeom ty $ S.SEPrep i where - isGeoTy d = case d of + +withGeom :: PGColType -> S.SQLExp -> S.SQLExp +withGeom (PGColType _ _ _ d) = case d of + PGTyBase x -> bool id applyGeomFromGeoJson $ isBaseTyGeo x + PGTyArray a -> case getArrayBaseTy a of + Just (PGColType _ _ _ (PGTyBase b)) -> bool id applyArrGeomFromGeoJson $ isBaseTyGeo b + _ -> id + _ -> id + where + isBaseTyGeo b = + case b of PGGeometry -> True PGGeography -> True _ -> False - --TODO : Change this to (select array_agg(ST_GeomFromGeoJSON(a) from unnest($1 :: ty[]) as a). Will work only for 1d array of Geometric types - applyArrGeomFromGeoJson = id - withGeom (PGColType _ _ _ d) = case d of - PGTyBase x -> bool id applyGeomFromGeoJson $ isGeoTy x - PGTyArray a -> case getArrayBaseTy a of - Just (PGColType _ _ _ (PGTyBase b)) -> bool id applyArrGeomFromGeoJson $ isGeoTy b - _ -> id - _ -> id + applyArrGeomFromGeoJson v = + S.SESelect $ S.mkSelect + { S.selExtr = + [ flip S.Extractor Nothing $ S.SEFnApp "array_agg" [applyGeomFromGeoJson $ S.SEIden $ toIden unnestF] Nothing + ] + , S.selFrom = Just $ S.FromExp [S.mkFuncFromItem qualUnnestF [v]] + } + qualUnnestF = + QualifiedObject catalogSchema unnestF + unnestF = + FunctionName "unnest" toTxtValue :: PGColType -> PGColValue -> S.SQLExp toTxtValue ty val = From b21aee1259645f0921925cfa94f6cd04bcbafe89 Mon Sep 17 00:00:00 2001 From: Nizar Malangadan Date: Tue, 12 Mar 2019 16:32:11 +0530 Subject: [PATCH 03/13] Fix error on schema diff --- server/src-lib/Hasura/GraphQL/Schema.hs | 2 +- server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs | 35 +++++++++++++++---- server/src-lib/Hasura/RQL/DDL/Schema/Table.hs | 18 +++------- server/src-lib/Hasura/RQL/Types/Common.hs | 10 ++++++ server/src-rsr/table_info.sql | 13 +------ 5 files changed, 45 insertions(+), 33 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index cb68933c77c39..0bb2f2771f5f2 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -174,7 +174,7 @@ mkPGColFld (PGColInfo colName colTy isNullable) = where n = G.Name $ getPGColTxt colName ty = bool notNullTy nullTy isNullable - scalarTy = mkScalarTy colTy + scalarTy = mkPGColGTy colTy notNullTy = G.toGT $ G.toNT scalarTy nullTy = G.toGT scalarTy diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs index 6f39cc8c94106..a7ce6aa76cd5e 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs @@ -38,7 +38,7 @@ data PGColMeta = PGColMeta { pcmColumnName :: !PGCol , pcmOrdinalPosition :: !Int - , pcmDataType :: !PGColType + , pcmDataType :: !PGColOidInfo , pcmIsNullable :: !Bool } deriving (Show, Eq) @@ -87,9 +87,32 @@ fetchTableMeta = do (SELECT table_schema, table_name, - json_agg((SELECT r FROM (SELECT column_name, udt_name AS data_type, ordinal_position, is_nullable::boolean) r)) as columns + json_agg((SELECT r FROM (SELECT column_name, + json_build_object( + 'oid', + td.atttypid :: int, + 'dimension', + td.attndims + ) AS data_type, + ordinal_position, + is_nullable::boolean) r)) as columns FROM - information_schema.columns + information_schema.columns c + LEFT OUTER JOIN ( + select pc.relnamespace, + pc.relname, + pa.attname, + pa.attndims, + pa.atttypid, + pa.atttypmod + from pg_attribute pa + left join pg_class pc + on pa.attrelid = pc.oid + ) td on + ( c.table_schema::regnamespace::oid = td.relnamespace + AND c.table_name = td.relname + AND c.column_name = td.attname + ) GROUP BY table_schema, table_name) c ON (t.table_schema = c.table_schema AND t.table_name = c.table_name) @@ -151,8 +174,8 @@ data TableDiff = TableDiff { _tdNewName :: !(Maybe QualifiedTable) , _tdDroppedCols :: ![PGCol] - , _tdAddedCols :: ![PGColInfo] - , _tdAlteredCols :: ![(PGColInfo, PGColInfo)] + , _tdAddedCols :: ![PGColInfo'] + , _tdAlteredCols :: ![(PGColInfo', PGColInfo')] , _tdDroppedFKeyCons :: ![ConstraintName] -- The final list of uniq/primary constraint names -- used for generating types on_conflict clauses @@ -183,7 +206,7 @@ getTableDiff oldtm newtm = existingCols = getOverlap pcmOrdinalPosition oldCols newCols pcmToPci (PGColMeta colName _ colType isNullable) - = PGColInfo colName colType isNullable + = PGColInfo' colName colType isNullable alteredCols = flip map (filter (uncurry (/=)) existingCols) $ pcmToPci *** pcmToPci diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs index 4bf1a8fd98c51..a407b9ddc6262 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs @@ -46,16 +46,6 @@ saveTableToCatalog (QualifiedObject sn tn) = INSERT INTO "hdb_catalog"."hdb_table" VALUES ($1, $2) |] (sn, tn) False -data PGColInfo' - = PGColInfo' - { pgipName :: !PGCol - , pgipType :: !PGColOidInfo - , pgipIsNullable :: !Bool - } deriving (Show, Eq) - - -$(deriveJSON (aesonDrop 4 snakeCase) ''PGColInfo') - -- Build the TableInfo with all its columns getTableInfo :: (QErrM m, CacheRWM m, MonadTx m) => QualifiedTable -> Bool -> m TableInfo @@ -75,7 +65,6 @@ toPGColTypes cols' = do pgTysMap <- zip cols' <$> toPGColTysWithCaching colOids' return $ flip map pgTysMap $ \(PGColInfo' na _ nu,pgColTy) -> PGColInfo na pgColTy nu - where newtype TrackTable = TrackTable @@ -180,7 +169,7 @@ processTableChanges ti tableDiff = do maybe withOldTabName withNewTabName mNewName where - TableDiff mNewName droppedCols addedCols alteredCols _ constraints = tableDiff + TableDiff mNewName droppedCols addedCols' alteredCols _ constraints = tableDiff replaceConstraints tn = flip modTableInCache tn $ \tInfo -> return $ tInfo {tiUniqOrPrimConstraints = constraints} @@ -189,8 +178,9 @@ processTableChanges ti tableDiff = do -- Drop the column from the cache delColFromCache droppedCol tn - procAddedCols tn = + procAddedCols tn = do -- In the newly added columns check that there is no conflict with relationships + addedCols <- toPGColTypes addedCols' forM_ addedCols $ \pci@(PGColInfo colName _ _) -> case M.lookup (fromPGCol colName) $ tiFieldInfoMap ti of Just (FIRelationship _) -> @@ -200,7 +190,7 @@ processTableChanges ti tableDiff = do _ -> addColToCache colName pci tn procAlteredCols sc tn = fmap or $ - forM alteredCols $ \(PGColInfo oColName oColTy _, PGColInfo nColName nColTy _) -> + forM alteredCols $ \(PGColInfo' oColName oColTy _, PGColInfo' nColName nColTy _) -> if | oColName /= nColName -> do renameColInCatalog oColName nColName tn ti return True diff --git a/server/src-lib/Hasura/RQL/Types/Common.hs b/server/src-lib/Hasura/RQL/Types/Common.hs index e5fa458cf0b7f..c22542810a025 100644 --- a/server/src-lib/Hasura/RQL/Types/Common.hs +++ b/server/src-lib/Hasura/RQL/Types/Common.hs @@ -2,6 +2,7 @@ module Hasura.RQL.Types.Common ( PGColInfo(..) , PGColInfo(JSONColInfo) + , PGColInfo'(..) , RelName(..) , RelType(..) , relTypeToTxt @@ -132,6 +133,15 @@ data PGColInfo $(deriveJSON (aesonDrop 3 snakeCase) ''PGColInfo) +data PGColInfo' + = PGColInfo' + { pgipName :: !PGCol + , pgipType :: !PGColOidInfo + , pgipIsNullable :: !Bool + } deriving (Show, Eq) + +$(deriveJSON (aesonDrop 4 snakeCase) ''PGColInfo') + pattern JSONColInfo :: PGCol -> Bool -> QualifiedType -> AnnType -> PQ.Oid -> PGColInfo pattern JSONColInfo a b x y z = PGColInfo a (PGColType x y z (PGTyBase PGJSON)) b diff --git a/server/src-rsr/table_info.sql b/server/src-rsr/table_info.sql index c53c454cfeea9..e3761aac2e140 100644 --- a/server/src-rsr/table_info.sql +++ b/server/src-rsr/table_info.sql @@ -50,18 +50,7 @@ from AND c.column_name = td.attname ) left outer join pg_type ty - on - ( ty.typname = - case - when c.domain_name is not null then c.domain_name - else c.udt_name - end - AND ty.typnamespace::regnamespace::text = - case - when c.domain_name is not null then c.domain_schema - else c.udt_schema - end - ) + on td.atttypid = ty.oid group by c.table_schema, c.table_name From 92fd747022e47f7fca7664b2f84abfc77b1abd94 Mon Sep 17 00:00:00 2001 From: Nizar Malangadan Date: Thu, 14 Mar 2019 01:34:14 +0530 Subject: [PATCH 04/13] Fix errors on adding function etc --- server/src-lib/Hasura/GraphQL/Context.hs | 54 +++++++---- server/src-lib/Hasura/GraphQL/Schema.hs | 34 ++++--- server/src-lib/Hasura/GraphQL/Validate.hs | 28 +++--- .../Hasura/GraphQL/Validate/Context.hs | 2 +- .../src-lib/Hasura/GraphQL/Validate/Field.hs | 2 +- .../Hasura/GraphQL/Validate/InputValue.hs | 91 ++++++++++--------- .../src-lib/Hasura/GraphQL/Validate/Types.hs | 42 ++++++--- .../src-lib/Hasura/RQL/DDL/Schema/PGType.hs | 4 +- server/src-lib/Hasura/RQL/GBoolExp.hs | 12 +-- .../src-lib/Hasura/RQL/Types/SchemaCache.hs | 1 - server/src-lib/Hasura/SQL/Types.hs | 46 ++++++---- server/src-lib/Hasura/SQL/Value.hs | 5 +- server/src-rsr/function_info.sql | 15 ++- ...nsert_into_array_col_with_array_input.yaml | 2 +- .../insert_area_less_than_4_points_err.yaml | 2 +- .../insert_geometry_unexpected_type_err.yaml | 2 +- .../insert_landmark_single_position_err.yaml | 2 +- ...ing_last_point_not_equal_to_first_err.yaml | 2 +- .../geojson/insert_road_single_point_err.yaml | 4 +- server/tests-py/test_graphql_mutations.py | 1 - 20 files changed, 197 insertions(+), 154 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Context.hs b/server/src-lib/Hasura/GraphQL/Context.hs index 1eb2158606d9e..3a6f842b05e78 100644 --- a/server/src-lib/Hasura/GraphQL/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Context.hs @@ -141,6 +141,10 @@ mkHsraObjFldInfo mkHsraObjFldInfo descM name params pgTy ty = ObjFldInfo descM name params pgTy ty HasuraType +mkHsraPGTyObjFld :: Maybe G.Description -> G.Name -> ParamMap -> PGColType -> ObjFldInfo +mkHsraPGTyObjFld descM name params colTy = + mkHsraObjFldInfo descM name params (Just $ PTCol colTy) $ mkPGColGTy colTy + mkHsraObjTyInfo :: Maybe G.Description -> G.NamedType @@ -173,8 +177,19 @@ fromInpValL :: [InpValInfo] -> Map.HashMap G.Name InpValInfo fromInpValL = mapFromL _iviName mkCompExpName :: PGColType -> G.Name -mkCompExpName pgColTy = - G.Name $ pgColTyToScalar pgColTy <> "_comparison_exp" +mkCompExpName colTy = + G.Name $ colTyTxt colTy <> "_comparison_exp" + where + colTyTxt t = case pgColTyDetails t of + PGTyBase b + -> T.pack (show b) + PGTyDomain b + -> colTyTxt b + _ + -> case getArrayBaseTy t of + Nothing -> qualTyToScalar (pgColTyName t) + -- Array type + Just b -> T.pack $ show b <> "_" <> show (getPGTyArrDim t) <> "d" mkCompExpTy :: PGColType -> G.NamedType mkCompExpTy = @@ -195,12 +210,12 @@ stDWithinInpTy = G.NamedType "st_d_within_input" mkCompExpInp :: PGColType -> InpObjTyInfo mkCompExpInp colTy@(PGColType _ _ _ colDtls) = InpObjTyInfo (Just tyDesc) (mkCompExpTy colTy) (fromInpValL $ concat - [ map (mk (Just $ PTCol colTy) colGQLTy) typedOps + [ map (mkPGTy colTy) typedOps , map (mk (Just $ arrOfCol colTy) $ G.toLT colGQLTy) listOps - , bool [] (map (mk (Just $ PTCol $ baseBuiltInTy PGText) $ mkScalarBaseTy PGText) stringOps) isStringTy + , bool [] (map (mkPGTy $ baseTy PGText) stringOps) isStringTy , bool [] (map jsonbOpToInpVal jsonbOps) isJsonbTy , bool [] (stDWithinOpInpVal : map geomOpToInpVal geomOps) isGeometryTy - , [InpValInfo Nothing "_is_null" Nothing (Just $ PTCol $ baseBuiltInTy PGBoolean) $ G.TypeNamed (G.Nullability True) $ G.NamedType "Boolean"] + , [mkPGTyInpVal Nothing "_is_null" $ baseTy PGBoolean] ]) HasuraType where arrOfCol = PTArr . PTCol @@ -209,14 +224,15 @@ mkCompExpInp colTy@(PGColType _ _ _ colDtls) = , G.Description (T.pack $ show colTy) , ". All fields are combined with logical 'AND'." ] - baseTy = case colDtls of + bTy = case colDtls of PGTyBase b -> return b _ -> Nothing - isStringTy = case baseTy of + isStringTy = case bTy of Just PGVarchar -> True Just PGText -> True _ -> False mk pt t n = InpValInfo Nothing n Nothing pt $ G.toGT t + mkPGTy ty = mk (Just $ PTCol ty) $ mkPGColGTy ty colGQLTy = mkPGColGTy colTy -- colScalarListTy = GA.GTList colGTy typedOps = @@ -231,45 +247,45 @@ mkCompExpInp colTy@(PGColType _ _ _ colDtls) = , "_similar", "_nsimilar" ] - isJsonbTy = case baseTy of + isJsonbTy = case bTy of Just PGJSONB -> True _ -> False - jsonbOpToInpVal (op, ty, desc) = InpValInfo (Just desc) op Nothing (Just $ PTCol $ baseBuiltInTy PGJSONB) ty + jsonbOpToInpVal (op, pgTy, desc) = InpValInfo (Just desc) op Nothing (Just pgTy) $ pgTyAnnToGTy pgTy jsonbOps = [ ( "_contains" - , G.toGT $ mkScalarBaseTy PGJSONB + , PTCol $ baseTy PGJSONB , "does the column contain the given json value at the top level" ) , ( "_contained_in" - , G.toGT $ mkScalarBaseTy PGJSONB + , PTCol $ baseTy PGJSONB , "is the column contained in the given json value" ) , ( "_has_key" - , G.toGT $ mkScalarBaseTy PGText + , PTCol $ baseTy PGText , "does the string exist as a top-level key in the column" ) , ( "_has_keys_any" - , G.toGT $ G.toLT $ G.toNT $ mkScalarBaseTy PGText + , PTArr $ PTCol $ baseTy PGText , "do any of these strings exist as top-level keys in the column" ) , ( "_has_keys_all" - , G.toGT $ G.toLT $ G.toNT $ mkScalarBaseTy PGText + , PTArr $ PTCol $ baseTy PGText , "do all of these strings exist as top-level keys in the column" ) ] -- Geometry related ops stDWithinOpInpVal = - InpValInfo (Just stDWithinDesc) "_st_d_within" Nothing (Just $ PTCol $ baseBuiltInTy PGGeometry) $ G.toGT stDWithinInpTy + InpValInfo (Just stDWithinDesc) "_st_d_within" Nothing Nothing $ G.toGT stDWithinInpTy stDWithinDesc = "is the column within a distance from a geometry value" - isGeometryTy = case baseTy of + isGeometryTy = case bTy of Just PGGeometry -> True _ -> False geomOpToInpVal (op, desc) = - InpValInfo (Just desc) op Nothing (Just $ PTCol $ baseBuiltInTy PGGeometry) $ G.toGT $ mkScalarBaseTy PGGeometry + mkPGTyInpVal (Just desc) op $ baseTy PGGeometry geomOps = [ ( "_st_contains" @@ -376,8 +392,8 @@ mkGCtx tyAgg (RootFlds flds) insCtxMap = stDWithinInpM = bool Nothing (Just stDWithinInp) (PGTyBase PGGeometry `elem` map pgColTyDetails colTys) stDWithinInp = mkHsraInpTyInfo Nothing stDWithinInpTy $ fromInpValL - [ InpValInfo Nothing "from" Nothing (Just $ PTCol $ baseBuiltInTy PGGeometry) $ G.toGT $ G.toNT $ mkScalarBaseTy PGGeometry - , InpValInfo Nothing "distance" Nothing (Just $ PTCol $ baseBuiltInTy PGGeometry) $ G.toNT $ G.toNT $ mkScalarBaseTy PGFloat + [ mkPGTyInpValNT Nothing "from" $ baseTy PGGeometry + , mkPGTyInpValNT Nothing "distance" $ baseTy PGFloat ] emptyGCtx :: GCtx diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index 0bb2f2771f5f2..ca046adf8d46a 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TemplateHaskell #-} module Hasura.GraphQL.Schema ( mkGCtxMap , GCtxMap @@ -185,8 +186,8 @@ mkPGColFld (PGColInfo colName colTy isNullable) = mkSelArgs :: QualifiedTable -> [InpValInfo] mkSelArgs tn = [ InpValInfo (Just whereDesc) "where" Nothing Nothing $ G.toGT $ mkBoolExpTy tn - , InpValInfo (Just limitDesc) "limit" Nothing Nothing $ G.toGT $ mkScalarBaseTy PGInteger - , InpValInfo (Just offsetDesc) "offset" Nothing Nothing $ G.toGT $ mkScalarBaseTy PGInteger + , mkPGTyInpVal (Just limitDesc) "limit" $ baseTy PGInteger + , mkPGTyInpVal (Just offsetDesc) "offset" $ baseTy PGInteger , InpValInfo (Just orderByDesc) "order_by" Nothing Nothing $ G.toGT $ G.toLT $ G.toNT $ mkOrdByTy tn , InpValInfo (Just distinctDesc) "distinct_on" Nothing Nothing $ G.toGT $ G.toLT $ @@ -322,13 +323,13 @@ mkTableAggFldsObj tn numCols compCols = desc = G.Description $ "aggregate fields of " <>> tn - countFld = mkHsraObjFldInfo Nothing "count" countParams (Just $ PTCol $ baseBuiltInTy PGInteger) $ G.toGT $ mkScalarBaseTy PGInteger + countFld = mkHsraPGTyObjFld Nothing "count" countParams $ baseTy PGInteger countParams = fromInpValL [countColInpVal, distinctInpVal] countColInpVal = InpValInfo Nothing "columns" Nothing Nothing $ G.toGT $ G.toLT $ G.toNT $ mkSelColumnInpTy tn - distinctInpVal = InpValInfo Nothing "distinct" Nothing (Just $ PTCol $ baseBuiltInTy PGBoolean) $ G.toGT $ mkScalarBaseTy PGBoolean + distinctInpVal = mkPGTyInpVal Nothing "distinct" $ baseTy PGBoolean numFlds = bool (map mkColOpFld numAggOps) [] $ null numCols compFlds = bool (map mkColOpFld compAggOps) [] $ null compCols @@ -346,7 +347,7 @@ type table__fields{ mkTableColAggFldsObj :: QualifiedTable -> G.Name - -> (PGColType -> G.NamedType) + -> (PGColType -> PGColType) -> [PGColInfo] -> ObjTyInfo mkTableColAggFldsObj tn op f cols = @@ -356,8 +357,8 @@ mkTableColAggFldsObj tn op f cols = desc = G.Description $ "aggregate " <> G.unName op <> " on columns" mkColObjFld c = let colTy = pgiType c in - mkHsraObjFldInfo Nothing (G.Name $ getPGColTxt $ pgiName c) - Map.empty (Just $ PTCol colTy) $ G.toGT $ f colTy + mkHsraPGTyObjFld Nothing (G.Name $ getPGColTxt $ pgiName c) + Map.empty $ f colTy {- @@ -511,8 +512,7 @@ mkMutRespObj tn sel nestAlwd = objDesc = G.Description $ "response of any mutation on the table " <>> tn affectedRowsFld = - mkHsraObjFldInfo (Just desc) "affected_rows" Map.empty (Just $ PTCol $ baseBuiltInTy PGInteger) $ - G.toGT $ G.toNT $ mkScalarBaseTy PGInteger + mkHsraPGTyObjFld (Just desc) "affected_rows" Map.empty $ baseTy PGInteger where desc = "number of affected rows by the mutation" returningFld = @@ -752,20 +752,18 @@ mkUpdJSONOpInp tn cols = bool inpObjs [] $ null jsonbCols deleteKeyInpObj = mkHsraInpTyInfo (Just deleteKeyDesc) (mkJSONOpTy tn deleteKeyOp) $ fromInpValL $ map deleteKeyInpVal jsonbColNames - deleteKeyInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ PTCol $ baseBuiltInTy PGText) $ - G.toGT $ G.NamedType "String" + deleteKeyInpVal c = mkPGTyInpVal Nothing (G.Name $ getPGColTxt c) $ baseTy PGText deleteElemInpObj = mkHsraInpTyInfo (Just deleteElemDesc) (mkJSONOpTy tn deleteElemOp) $ fromInpValL $ map deleteElemInpVal jsonbColNames - deleteElemInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ PTCol $ baseBuiltInTy PGInteger) $ - G.toGT $ G.NamedType "Int" + deleteElemInpVal c = mkPGTyInpVal Nothing (G.Name $ getPGColTxt c) $ baseTy PGInteger deleteAtPathInpObj = mkHsraInpTyInfo (Just deleteAtPathDesc) (mkJSONOpTy tn deleteAtPathOp) $ fromInpValL $ map deleteAtPathInpVal jsonbColNames - deleteAtPathInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ PTCol $ baseBuiltInTy PGText) $ - G.toGT $ G.toLT $ G.NamedType "String" + deleteAtPathInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ PTArr $ PTCol $ baseTy PGText) $ + G.toGT $ G.toLT $ mkPGColGTy $ baseTy PGText {- @@ -1401,16 +1399,16 @@ mkGCtxRole' tn allCols insPermM selPermM updColsM getNumCols = onlyNumCols . lefts getCompCols = onlyComparableCols . lefts - onlyFloat = const $ mkScalarBaseTy PGFloat + onlyFloat = const $ baseTy PGFloat - mkTypeMaker "sum" = mkScalarTy + mkTypeMaker "sum" = id mkTypeMaker _ = onlyFloat mkColAggFldsObjs flds = let numCols = getNumCols flds compCols = getCompCols flds mkNumObjFld n = mkTableColAggFldsObj tn n (mkTypeMaker n) numCols - mkCompObjFld n = mkTableColAggFldsObj tn n mkScalarTy compCols + mkCompObjFld n = mkTableColAggFldsObj tn n id compCols numFldsObjs = bool (map mkNumObjFld numAggOps) [] $ null numCols compFldsObjs = bool (map mkCompObjFld compAggOps) [] $ null compCols in numFldsObjs <> compFldsObjs diff --git a/server/src-lib/Hasura/GraphQL/Validate.hs b/server/src-lib/Hasura/GraphQL/Validate.hs index 1ceab604a9ec7..9fe5fa649ea12 100644 --- a/server/src-lib/Hasura/GraphQL/Validate.hs +++ b/server/src-lib/Hasura/GraphQL/Validate.hs @@ -8,6 +8,7 @@ module Hasura.GraphQL.Validate import Data.Has import Hasura.Prelude +import Data.Aeson.Internal (JSONPathElement(..)) import qualified Data.HashMap.Strict as Map import qualified Language.GraphQL.Draft.Syntax as G @@ -61,7 +62,7 @@ getVarVals ) => [G.VariableDefinition] -> VariableValues - -> m VarVals + -> m VarValsMap getVarVals varDefsL inpVals = do varDefs <- onLeft (mkMapWith G._vdVariable varDefsL) $ \dups -> @@ -80,20 +81,10 @@ getVarVals varDefsL inpVals = do -- check that the variable is defined on input types when (isObjTy baseTyInfo) $ throwVE $ objTyErrMsg baseTy - let defM' = bool (defM <|> Just G.VCNull) defM $ G.isNotNull ty + let defM' = bool defM (defM <|> Just G.VCNull) $ G.isNotNull ty let inpValM = Map.lookup var inpVals - when (isNothing inpValM && isNothing defM') $ throwVE $ "expecting a value for non-null type: " <> G.showGT ty <> " in variableValues" + when (isNothing inpValM && isNothing defM' && G.isNotNull ty) $ throwVE $ "expecting a value for non-null type: " <> G.showGT ty <> " in variableValues" return (ty,defM',inpValM) - --let annValF pgTy = do - -- annDefM <- withPathK "defaultValue" $ - -- mapM (validateInputValue constValueParser ty pgTy) defM' - - -- annInpValM <- withPathK "variableValues" $ - -- mapM (validateInputValue jsonParser ty pgTy) inpValM - - -- let annValM = annInpValM <|> annDefM - -- onNothing annValM $ throwVE $ "expecting a value for non-null type: " <> G.showGT ty <> " in variableValues" - --return annValF where objTyErrMsg namedTy = "variables can only be defined on input types" @@ -135,7 +126,7 @@ validateGQ (QueryParts opDef opRoot fragDefsL varValsM) = do -- onNothing (_gSubRoot ctx) $ throwVE "no subscriptions exist" -- annotate the variables of this operation - annVarVals <- getVarVals (G._todVariableDefinitions opDef) $ + varVals <- getVarVals (G._todVariableDefinitions opDef) $ fromMaybe Map.empty varValsM -- annotate the fragments @@ -145,9 +136,9 @@ validateGQ (QueryParts opDef opRoot fragDefsL varValsM) = do annFragDefs <- mapM validateFrag fragDefs -- build a validation ctx - let valCtx = ValidationCtx (_gTypes ctx) annVarVals annFragDefs + let valCtx = ValidationCtx (_gTypes ctx) varVals annFragDefs - selSet <- flip runReaderT valCtx $ denormSelSet [] opRoot $ + selSet <- flip runReaderT valCtx $ pathFromRoot $ denormSelSet [] opRoot $ G._todSelectionSet opDef when (G._todType opDef == G.OperationTypeSubscription && length selSet > 1) $ @@ -155,6 +146,11 @@ validateGQ (QueryParts opDef opRoot fragDefsL varValsM) = do return (G._todType opDef, selSet) +pathFromRoot :: (MonadError QErr m) => m a -> m a +pathFromRoot f = f `catchError` (throwError . fromRoot) + where + fromRoot q = q { qePath = frp $ qePath q} + where frp = reverse . takeWhile (/= Key "$") . reverse getQueryParts :: ( MonadError QErr m, MonadReader GCtx m) diff --git a/server/src-lib/Hasura/GraphQL/Validate/Context.hs b/server/src-lib/Hasura/GraphQL/Validate/Context.hs index e25371570bc2d..55e16d77c6433 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Context.hs @@ -37,7 +37,7 @@ data ValidationCtx = ValidationCtx { _vcTypeMap :: !TypeMap -- these are in the scope of the operation - , _vcVarVals :: !VarVals + , _vcVarVals :: !VarValsMap -- all the fragments , _vcFragDefMap :: !FragDefMap } deriving (Show, Eq) diff --git a/server/src-lib/Hasura/GraphQL/Validate/Field.hs b/server/src-lib/Hasura/GraphQL/Validate/Field.hs index 82e9565dd5481..a48ef5fb01603 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Field.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Field.hs @@ -184,7 +184,7 @@ processArgs fldParams argsL = do inpArgs <- forM args $ \(G.Argument argName argVal) -> withPathK (G.unName argName) $ do argTy <- getArgTy argName - validateInputValue (valueParser $ _iviPGTyAnn argTy) (_iviType argTy) (_iviPGTyAnn argTy) argVal + validateInputValue valueParser (_iviType argTy) (_iviPGTyAnn argTy) argVal forM_ requiredParams $ \argDef -> do let param = _iviName argDef diff --git a/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs b/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs index 70de412b4747e..6b3116b929d31 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs @@ -10,8 +10,6 @@ import Data.Scientific (fromFloatDigits) import Hasura.Prelude import Hasura.Server.Utils (duplicates) -import Data.Has - import qualified Data.Aeson as J import qualified Data.HashMap.Strict as Map import qualified Data.HashMap.Strict.InsOrd as OMap @@ -25,7 +23,7 @@ import Hasura.GraphQL.Validate.Types import Hasura.RQL.Types import Hasura.SQL.Value -newtype P a = P { unP :: Maybe (Either AnnGValue a)} +newtype P a = P { unP :: Maybe (Either G.Variable a)} pNull :: (Monad m) => m (P a) pNull = return $ P Nothing @@ -36,20 +34,13 @@ pVal = return . P . Just . Right resolveVar :: ( MonadError QErr m , MonadReader ValidationCtx m) - => Maybe PGColTyAnn -> G.Variable -> m AnnGValue -resolveVar pgTy var = do + => G.Variable -> m VarVal +resolveVar var = do varVals <- _vcVarVals <$> ask -- TODO typecheck - (ty,defM,inpValM) <- onNothing (Map.lookup var varVals) $ + onNothing (Map.lookup var varVals) $ throwVE $ "no such variable defined in the operation: " <> showName (G.unVariable var) - annDefM <- withPathK "defaultValue" $ - mapM (validateInputValue constValueParser ty pgTy) defM - annInpValM <- withPathK "variableValues" $ - mapM (validateInputValue jsonParser ty pgTy) inpValM - let annValM = annInpValM <|> annDefM - onNothing annValM $ throwVE $ "expecting a value for non-null type: " <> G.showGT ty <> " in variableValues" - --return annValF where typeCheck expectedTy actualTy = case (expectedTy, actualTy) of -- named types @@ -58,13 +49,8 @@ resolveVar pgTy var = do (G.TypeList _ eTy, G.TypeList _ aTy) -> typeCheck (G.unListType eTy) (G.unListType aTy) (_, _) -> False -pVar - :: ( MonadError QErr m - , MonadReader ValidationCtx m) - => Maybe PGColTyAnn -> G.Variable -> m (P a) -pVar pgTy var = do - annInpVal <- resolveVar pgTy var - return . P . Just . Left $ annInpVal +pVar :: (Monad m) => G.Variable -> m (P a) +pVar var = return . P . Just . Left $ var data InputValueParser a m = InputValueParser @@ -111,30 +97,30 @@ toJValue = \case toTup (G.ObjectFieldG f v) = (f,) <$> toJValue v valueParser - :: ( MonadError QErr m - , MonadReader ValidationCtx m) - => Maybe PGColTyAnn -> InputValueParser G.Value m -valueParser pgTy = + :: MonadError QErr m + => InputValueParser G.Value m +valueParser = InputValueParser pScalar pList pObject pEnum where - pEnum (G.VVariable var) = pVar pgTy var + pEnum (G.VVariable var) = pVar var pEnum (G.VEnum e) = pVal e pEnum G.VNull = pNull pEnum _ = throwVE "expecting an enum" - pList (G.VVariable var) = pVar pgTy var + pList (G.VVariable var) = pVar var pList (G.VList lv) = pVal $ G.unListValue lv pList G.VNull = pNull pList v = pVal [v] - pObject (G.VVariable var) = pVar pgTy var + pObject (G.VVariable var) = pVar var pObject (G.VObject ov) = pVal [(G._ofName oFld, G._ofValue oFld) | oFld <- G.unObjectValue ov] - pObject G.VNull = pNull + pObject G.VNull = pNull pObject _ = throwVE "expecting an object" + -- scalar json - pScalar (G.VVariable var) = pVar pgTy var + pScalar (G.VVariable var) = pVar var pScalar G.VNull = pNull pScalar (G.VInt v) = pVal $ J.Number $ fromIntegral v pScalar (G.VFloat v) = pVal $ J.Number $ fromFloatDigits v @@ -201,7 +187,7 @@ constValueParser = pScalar v = pVal $ toJValueC v validateObject - :: ( MonadReader r m, Has TypeMap r + :: ( MonadReader ValidationCtx m , MonadError QErr m ) => InputValueParser a m @@ -235,11 +221,12 @@ validateObject valParser tyInfo flds = do dups = duplicates inpFldNames validateNamedTypeVal - :: ( MonadReader r m, Has TypeMap r + :: ( MonadReader ValidationCtx m , MonadError QErr m) => InputValueParser a m + -> Maybe PGColTyAnn -> G.NamedType -> a -> m AnnGValue -validateNamedTypeVal inpValParser nt val = do +validateNamedTypeVal inpValParser pgTyAnn nt val = do tyInfo <- getTyInfo nt case tyInfo of -- this should never happen @@ -250,17 +237,17 @@ validateNamedTypeVal inpValParser nt val = do TIUnion _ -> throwUnexpTypeErr "union" TIInpObj ioti -> - withParsed (getObject inpValParser) val $ + withVarVal pgTyAnn (getObject inpValParser) val $ fmap (AGObject nt) . mapM (validateObject inpValParser ioti) TIEnum eti -> - withParsed (getEnum inpValParser) val $ + withVarVal pgTyAnn (getEnum inpValParser) val $ fmap (AGEnum nt) . mapM (validateEnum eti) TIScalar (ScalarTyInfo _ t _)-> throwUnexpNoPGTyErr t where throwUnexpTypeErr ty = throw500 $ "unexpected " <> ty <> " type info for: " <> showNamedTy nt - throwUnexpNoPGTyErr ty = throw500 $ "No PGColType found for type " <> (G.unName ty) + throwUnexpNoPGTyErr ty = throw500 $ "No PGColType annotation found for scalar type " <> (G.unName ty) validateEnum enumTyInfo enumVal = if Map.member enumVal (_etiValues enumTyInfo) then return enumVal @@ -269,14 +256,14 @@ validateNamedTypeVal inpValParser nt val = do " for enum: " <> showNamedTy nt validateList - :: (MonadError QErr m, MonadReader r m, Has TypeMap r) + :: (MonadError QErr m, MonadReader ValidationCtx m) => InputValueParser a m -> G.ListType -> Maybe PGColTyAnn -> a -> m AnnGValue validateList inpValParser listTy pgTyAnn val = - withParsed (getList inpValParser) val $ \lM -> do + withVarVal pgTyAnn (getList inpValParser) val $ \lM -> do let baseTy = G.unListType listTy AGArray listTy <$> mapM (indexedMapM (validateInputValue inpValParser baseTy pgTyAnn)) lM @@ -296,7 +283,7 @@ validateList inpValParser listTy pgTyAnn val = -- return parsedVal validateInputValue - :: (MonadError QErr m, MonadReader r m, Has TypeMap r) + :: (MonadError QErr m, MonadReader ValidationCtx m) => InputValueParser a m -> G.GType -> Maybe PGColTyAnn @@ -304,12 +291,12 @@ validateInputValue -> m AnnGValue validateInputValue inpValParser ty Nothing val = case ty of - G.TypeNamed _ nt -> validateNamedTypeVal inpValParser nt val + G.TypeNamed _ nt -> validateNamedTypeVal inpValParser Nothing nt val G.TypeList _ lt -> validateList inpValParser lt Nothing val validateInputValue inpValParser ty (Just pgTyAnn) val = case (pgTyAnn,ty) of (PTCol colTy,_) -> - withParsed (getScalar inpValParser) val $ + withVarVal (Just pgTyAnn) (getScalar inpValParser) val $ fmap (AGPGVal colTy) . mapM (validatePGVal colTy) (PTArr pgElemTyAnn,G.TypeList _ lt) -> validateList inpValParser lt (Just pgElemTyAnn) val @@ -318,15 +305,29 @@ validateInputValue inpValParser ty (Just pgTyAnn) val = <> " for GraphQL type " <> T.pack (show ty) where validatePGVal pct = runAesonParser (parsePGValue pct) -withParsed - :: (Monad m) - => (val -> m (P specificVal)) +withVarVal + :: (MonadReader ValidationCtx m + , MonadError QErr m) + => (Maybe PGColTyAnn) + -> (val -> m (P specificVal)) -> val -> (Maybe specificVal -> m AnnGValue) -> m AnnGValue -withParsed valParser val fn = do +withVarVal pgTy valParser val fn = do parsedVal <- valParser val case unP parsedVal of Nothing -> fn Nothing Just (Right a) -> fn $ Just a - Just (Left annVal) -> return annVal + Just (Left var) -> withPathKeys ["$","variables",G.unName $ G.unVariable var] $ do + -- TODO Remove defaulting to Null and allow withVarVal to return (Maybe AnnGValue) + (ty,defM,inpValM) <- resolveVar var + let defM' = defM <|> Just G.VCNull + annDefM' <- withPathK "defaultValue" $ + mapM (validateInputValue constValueParser ty pgTy) defM' + annInpValM <- mapM (validateInputValue jsonParser ty pgTy) inpValM + let annValM = annInpValM <|> annDefM' + onNothing annValM $ throwVE $ "expecting a value for non-null type: " + <> G.showGT ty <> " in variableValues" + where + withPathKeys [] = id + withPathKeys (x:xs) = withPathK x . withPathKeys xs diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index 2e8dcbe856215..2580ceb5014f2 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -12,7 +12,8 @@ module Hasura.GraphQL.Validate.Types , FragDef(..) , FragDefMap -- , AnnVarVals - , VarVals + , VarVal + , VarValsMap , EnumTyInfo(..) , EnumValInfo(..) , InpObjFldMap @@ -35,8 +36,11 @@ module Hasura.GraphQL.Validate.Types , mkScalarBaseTy , pgColTyToScalar , pgColValToAnnGVal + , pgTyAnnToGTy , getNamedTy , mkTyInfoMap + , mkPGTyInpVal + , mkPGTyInpValNT , fromTyDef , fromTyDefQ , fromSchemaDoc @@ -51,6 +55,7 @@ module Hasura.GraphQL.Validate.Types , getAnnInpValTy , GQLColTyMap , PGColTyAnn(..) + , qualTyToScalar , module Hasura.GraphQL.Utils ) where @@ -116,6 +121,10 @@ data PGColTyAnn | PTArr PGColTyAnn deriving (Show, Eq, TH.Lift) +pgTyAnnToGTy :: PGColTyAnn -> G.GType +pgTyAnnToGTy (PTCol colTy) = mkPGColGTy colTy +pgTyAnnToGTy (PTArr p) = G.toGT $ G.toLT $ G.toNT $ pgTyAnnToGTy p + data InpValInfo = InpValInfo { _iviDesc :: !(Maybe G.Description) @@ -134,6 +143,12 @@ fromInpValDef (G.InputValueDefinition descM n ty defM) gctm = InpValInfo descM n defM pgTy ty where pgTy = fmap PTCol $ Map.lookup (getBaseTy ty, getArrDim ty) gctm +mkPGTyInpVal :: Maybe G.Description -> G.Name -> PGColType -> InpValInfo +mkPGTyInpVal desc name colTy = InpValInfo desc name Nothing (Just $ PTCol colTy) $ mkPGColGTy colTy + +mkPGTyInpValNT :: Maybe G.Description -> G.Name -> PGColType -> InpValInfo +mkPGTyInpValNT desc name colTy = InpValInfo desc name Nothing (Just $ PTCol colTy) $ G.toNT $ mkPGColGTy colTy + type ParamMap = Map.HashMap G.Name InpValInfo -- | location of the type: a hasura type or a remote type @@ -504,11 +519,12 @@ isSubTypeBase subTyInfo supTyInfo = case (subTyInfo,supTyInfo) of pgColTyToScalar :: PGColType -> Text pgColTyToScalar (PGColType qn _ _ d) = case d of PGTyBase b -> pgBaseColTyToScalar b - _ -> qualTypeToScalar qn - where - qualTypeToScalar (QualifiedObject (SchemaName s) n) - | s `elem` ["pg_catalog","public"] = getTyText n - | otherwise = s <> "_" <> getTyText n + _ -> qualTyToScalar qn + +qualTyToScalar :: QualifiedType -> Text +qualTyToScalar (QualifiedObject (SchemaName s) n) + | s `elem` ["pg_catalog","public"] = getTyText n + | otherwise = s <> "_" <> getTyText n -- map postgres types to builtin scalars pgBaseColTyToScalar :: PGBaseColType -> Text @@ -591,7 +607,7 @@ type GQLColTyMap = Map.HashMap (G.NamedType,ArrDim) PGColType defaultPGColTyMap :: GQLColTyMap defaultPGColTyMap = Map.fromList $ - map (\(x,y) -> ( (G.NamedType $ G.Name x,0), baseBuiltInTy y)) $ + map (\(x,y) -> ( (G.NamedType $ G.Name x,0), baseTy y)) $ [ ("Int" , PGInteger) , ("Float" , PGFloat ) , ("String" , PGText ) @@ -622,9 +638,8 @@ defaultDirectives = [mkDirective "skip", mkDirective "include"] where mkDirective n = DirectiveInfo Nothing n args dirLocs - args = Map.singleton "if" $ InpValInfo Nothing "if" Nothing - (Just $ PTCol $ baseBuiltInTy PGBoolean) $ - G.TypeNamed (G.Nullability False) $ G.NamedType $ G.Name "Boolean" + args = Map.singleton "if" $ mkPGTyInpValNT Nothing "if" $ + baseTy PGBoolean dirLocs = map G.DLExecutable [G.EDLFIELD, G.EDLFRAGMENT_SPREAD, G.EDLINLINE_FRAGMENT] @@ -640,9 +655,10 @@ data FragDef type FragDefMap = Map.HashMap G.Name FragDef -type VarVals = - Map.HashMap G.Variable - (G.GType,Maybe G.DefaultValue,Maybe J.Value) +type VarVal = (G.GType, Maybe G.DefaultValue, Maybe J.Value) + +type VarValsMap = + Map.HashMap G.Variable VarVal type AnnGObject = OMap.InsOrdHashMap G.Name AnnGValue diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs b/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs index 01f58ac9a167c..d0128f95742df 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs @@ -21,7 +21,7 @@ toPGColTysWithCaching :: (QErrM m, CacheRWM m, MonadTx m) => [PGColOidInfo] -> m toPGColTysWithCaching oids = do curTysCache <- addPGTysToCache $ Set.fromList oids forM oids $ \oid -> onNothing (Map.lookup oid curTysCache) $ throw500 $ - "Could not find Postgres type with oid info" <> T.pack (show oid) + "Could not find Postgres type with oid info" <> T.pack (show oid) getPGColTysMap :: Set.HashSet PGColOidInfo -> Q.TxE QErr (Map.HashMap PGColOidInfo PGColType) getPGColTysMap ctis = do @@ -37,7 +37,7 @@ addPGTysToCache i = do let inCache x = isJust $ Map.lookup x tysCache if (all inCache i) then return tysCache - else updatePGTysCache $ Set.union i $ Set.fromList $ Map.keys tysCache + else updatePGTysCache i updatePGTysCache :: (CacheRWM m, MonadTx m) => Set.HashSet PGColOidInfo -> m (Map.HashMap PGColOidInfo PGColType) updatePGTysCache iTys = do diff --git a/server/src-lib/Hasura/RQL/GBoolExp.hs b/server/src-lib/Hasura/RQL/GBoolExp.hs index 5d63ee01e381b..7b99ccfa767f3 100644 --- a/server/src-lib/Hasura/RQL/GBoolExp.hs +++ b/server/src-lib/Hasura/RQL/GBoolExp.hs @@ -78,8 +78,8 @@ parseOpExp parser fim (PGColInfo cn colTy _) (opStr, val) = withErrPath $ "$contains" -> jsonbOnlyOp $ AContains <$> parseOne "_contained_in" -> jsonbOnlyOp $ AContainedIn <$> parseOne "$contained_in" -> jsonbOnlyOp $ AContainedIn <$> parseOne - "_has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy (baseBuiltInTy PGText) - "$has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy (baseBuiltInTy PGText) + "_has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy (baseTy PGText) + "$has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy (baseTy PGText) --FIXME:- Parse a session variable as text array values --TODO:- Add following commented operators after fixing above said @@ -157,14 +157,14 @@ parseOpExp parser fim (PGColInfo cn colTy _) (opStr, val) = withErrPath $ jsonbOnlyOp m = case pgColTyDetails colTy of PGTyBase PGJSONB -> m - _ -> throwError $ buildMsg colTy [baseBuiltInTy PGJSONB] + _ -> throwError $ buildMsg colTy [baseTy PGJSONB] parseGeometryOp f = geometryOnlyOp colTy >> f <$> parseOne parseSTDWithinObj = do WithinOp distVal fromVal <- parseVal - dist <- withPathK "distance" $ parser (baseBuiltInTy PGFloat) distVal + dist <- withPathK "distance" $ parser (baseTy PGFloat) distVal from <- withPathK "from" $ parser colTy fromVal return $ ASTDWithin $ WithinOp dist from @@ -181,7 +181,7 @@ parseOpExp parser fim (PGColInfo cn colTy _) (opStr, val) = withErrPath $ geometryOnlyOp (PGGeomTy{}) = return () geometryOnlyOp ty = - throwError $ buildMsg ty [baseBuiltInTy PGGeometry] + throwError $ buildMsg ty [baseTy PGGeometry] parseWithTy ty = parser ty val parseOne = parseWithTy colTy @@ -222,7 +222,7 @@ textOnlyOp colTy = case pgColTyDetails colTy of textOnlyOp' PGText = return () textOnlyOp' PGVarchar = return () textOnlyOp' _ = onlyTxtTyErr - onlyTxtTyErr = throwError $ buildMsg colTy $ baseBuiltInTy <$> [PGVarchar, PGText] + onlyTxtTyErr = throwError $ buildMsg colTy $ baseTy <$> [PGVarchar, PGText] -- This convoluted expression instead of col = val -- to handle the case of col : null diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index 6d83ad97b9c74..816c6afdfed03 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -187,7 +187,6 @@ partitionFieldInfosWith fns = biMapEither (f1, f2) = either (Left . f1) (Right . f2) type FieldInfoMap = M.HashMap FieldName FieldInfo ---type FieldInfoMap' = M.HashMap FieldName FieldInfo' getCols :: FieldInfoMap -> [PGColInfo] getCols fim = lefts $ map fieldInfoToEither $ M.elems fim diff --git a/server/src-lib/Hasura/SQL/Types.hs b/server/src-lib/Hasura/SQL/Types.hs index 1206829daa348..4144cb849b27b 100644 --- a/server/src-lib/Hasura/SQL/Types.hs +++ b/server/src-lib/Hasura/SQL/Types.hs @@ -14,7 +14,7 @@ import Data.Aeson.Casing import Data.Aeson.Encoding (text) import Data.String (fromString) import Instances.TH.Lift () -import Language.Haskell.TH.Syntax (Lift) +import qualified Language.Haskell.TH.Syntax as TH import qualified Data.HashMap.Strict.InsOrd as OMap import qualified Data.Text.Extended as T @@ -96,7 +96,7 @@ class ToTxt a where newtype TableName = TableName { getTableTxt :: T.Text } - deriving (Show, Eq, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, Lift) + deriving (Show, Eq, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, TH.Lift) instance IsIden TableName where toIden (TableName t) = Iden t @@ -140,7 +140,7 @@ isView _ = False newtype ConstraintName = ConstraintName { getConstraintTxt :: T.Text } - deriving (Show, Eq, FromJSON, ToJSON, Q.ToPrepArg, Q.FromCol, Hashable, Lift) + deriving (Show, Eq, FromJSON, ToJSON, Q.ToPrepArg, Q.FromCol, Hashable, TH.Lift) instance IsIden ConstraintName where toIden (ConstraintName t) = Iden t @@ -150,7 +150,7 @@ instance ToSQL ConstraintName where newtype FunctionName = FunctionName { getFunctionTxt :: T.Text } - deriving (Show, Eq, Ord, FromJSON, ToJSON, Q.ToPrepArg, Q.FromCol, Hashable, Lift) + deriving (Show, Eq, Ord, FromJSON, ToJSON, Q.ToPrepArg, Q.FromCol, Hashable, TH.Lift) instance IsIden FunctionName where toIden (FunctionName t) = Iden t @@ -166,7 +166,7 @@ instance ToTxt FunctionName where newtype SchemaName = SchemaName { getSchemaTxt :: T.Text } - deriving (Show, Eq, Ord, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, Lift) + deriving (Show, Eq, Ord, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, TH.Lift) publicSchema :: SchemaName publicSchema = SchemaName "public" @@ -184,7 +184,7 @@ data QualifiedObject a = QualifiedObject { qSchema :: !SchemaName , qName :: !a - } deriving (Show, Eq, Ord, Generic, Lift) + } deriving (Show, Eq, Ord, Generic, TH.Lift) instance (FromJSON a) => FromJSON (QualifiedObject a) where parseJSON v@(String _) = @@ -236,7 +236,7 @@ type QualifiedFunction = QualifiedObject FunctionName newtype PGCol = PGCol { getPGColTxt :: T.Text } - deriving (Show, Eq, Ord, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, ToJSONKey, FromJSONKey, Lift) + deriving (Show, Eq, Ord, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, ToJSONKey, FromJSONKey, TH.Lift) instance IsIden PGCol where toIden (PGCol t) = Iden t @@ -253,7 +253,7 @@ showPGCols cols = newtype AnnType = AnnType {unAnnType :: T.Text} - deriving (Show, Eq, Generic, Lift, ToJSON, FromJSON) + deriving (Show, Eq, Generic, TH.Lift, ToJSON, FromJSON) instance Hashable AnnType @@ -276,14 +276,14 @@ jsonbType :: AnnType jsonbType = AnnType "jsonb" newtype PGTyFldName = PGTyFldName { getTyFldText :: T.Text } - deriving (Show, Eq, FromJSON, ToJSON, ToJSONKey, FromJSONKey, Hashable, Q.ToPrepArg, Q.FromCol, Lift) + deriving (Show, Eq, FromJSON, ToJSON, ToJSONKey, FromJSONKey, Hashable, Q.ToPrepArg, Q.FromCol, TH.Lift) newtype EnumVal = EnumVal { getEnumVal :: T.Text } - deriving (Show, Eq, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, Lift) + deriving (Show, Eq, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, TH.Lift) newtype PGTyName = PGTyName { getTyText :: T.Text } - deriving (Show, Eq, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, Lift) + deriving (Show, Eq, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, TH.Lift) instance ToTxt PGTyName where toTxt = getTyText @@ -311,7 +311,7 @@ data PGBaseColType | PGGeometry | PGGeography | PGUnknown !T.Text - deriving (Eq, Lift, Generic) + deriving (Eq, TH.Lift, Generic) instance Hashable PGBaseColType @@ -404,24 +404,30 @@ data PGColTyDetails | PGTyEnum ![EnumVal] | PGTyRange | PGTyPseudo - deriving (Show, Eq, Lift, Generic) + deriving (Show, Eq, TH.Lift, Generic) instance Hashable PGColTyDetails getArrayBaseTy :: PGColType -> Maybe PGColType -getArrayBaseTy (PGColType _ _ _ x) = case x of - PGTyArray a@(PGColType _ _ _ y) -> case y of - PGTyArray{} -> getArrayBaseTy a - _ -> Just a +getArrayBaseTy x = case pgColTyDetails x of + PGTyArray b -> case pgColTyDetails b of + PGTyArray{} -> getArrayBaseTy b + _ -> Just b _ -> Nothing +getPGTyArrDim :: PGColType -> Int +getPGTyArrDim colTy = case pgColTyDetails colTy of + PGTyArray bTy -> 1 + getPGTyArrDim bTy + PGTyDomain bTy -> getPGTyArrDim bTy + _ -> 0 + data PGColType = PGColType { pgColTyName :: !QualifiedType , pgColTySqlName :: !AnnType , pgColTyOid :: !PQ.Oid , pgColTyDetails :: !PGColTyDetails - } deriving (Show, Eq, Lift, Generic) + } deriving (Show, Eq, TH.Lift, Generic) $(deriveJSON defaultOptions { constructorTagModifier = snakeCase . drop 4 @@ -430,8 +436,8 @@ $(deriveJSON ''PGColTyDetails) $(deriveJSON (aesonDrop 7 camelCase) ''PGColType) -baseBuiltInTy :: PGBaseColType -> PGColType -baseBuiltInTy b = PGColType qualfdType (AnnType name) (pgTypeOid b)$ PGTyBase b +baseTy :: PGBaseColType -> PGColType +baseTy b = PGColType qualfdType (AnnType name) (pgTypeOid b)$ PGTyBase b where qualfdType = QualifiedObject (SchemaName "pg_catalog") (PGTyName name) name = T.pack $ show b diff --git a/server/src-lib/Hasura/SQL/Value.hs b/server/src-lib/Hasura/SQL/Value.hs index c6c475294f645..39d9de92b2eec 100644 --- a/server/src-lib/Hasura/SQL/Value.hs +++ b/server/src-lib/Hasura/SQL/Value.hs @@ -1,6 +1,7 @@ {-# LANGUAGE PatternSynonyms #-} module Hasura.SQL.Value where + import Hasura.SQL.GeoJSON import Hasura.SQL.Time import Hasura.SQL.Types @@ -150,7 +151,7 @@ paTxtEncBase c = case c of PGValDouble i -> (oidBuiltIn i, T.pack $ show i) PGValNumeric i -> (oidBuiltIn i, T.pack $ show i) PGValBoolean i -> (oidBuiltIn i, T.pack $ show i) - PGValChar i -> (oidBuiltIn i, T.pack $ show i) + PGValChar i -> (oidBuiltIn i, T.pack [i]) PGValVarchar t -> (oidBuiltIn t, t) PGValText t -> (oidBuiltIn t, t) PGValDate d -> (oidBuiltIn d, T.pack $ showGregorian d) @@ -172,7 +173,7 @@ data TxtEncInfo paTxtEnc :: PGColValue -> TxtEncInfo paTxtEnc (PGColValue oid v) = case v of PGValBase (PGValKnown x) -> let y = paTxtEncBase x in TxtEncInfo (fst y) True (snd y) - PGValBase (PGValUnknown x) -> TxtEncInfo oid True $ T.pack $ show x + PGValBase (PGValUnknown x) -> TxtEncInfo oid True x PGValDomain x -> paTxtEnc x PGValComposite x -> TxtEncInfo oid True x PGValRange x -> TxtEncInfo oid True x diff --git a/server/src-rsr/function_info.sql b/server/src-rsr/function_info.sql index 46d46762db350..d406608569f7e 100644 --- a/server/src-rsr/function_info.sql +++ b/server/src-rsr/function_info.sql @@ -12,9 +12,20 @@ SELECT hf.return_type_name, hf.return_type_type, hf.returns_set, - hf.input_arg_types, hf.input_arg_names, - COALESCE(pp.proallargtypes, pp.proargtypes::int[]) as arg_oids, + ( + select json_agg(row_to_json(x)) from + ( select + fo.oid as oid, + case + when arr_elem_ty.oid is NOT NULL then 1 + else 0 + end as dimension + from + (select unnest( COALESCE(pp.proallargtypes, pp.proargtypes) :: int[]) as oid ) fo + left outer join pg_type arr_elem_ty on arr_elem_ty.typarray = fo.oid + ) x + ) as input_arg_types, exists( SELECT 1 diff --git a/server/tests-py/queries/graphql_mutation/insert/basic/insert_into_array_col_with_array_input.yaml b/server/tests-py/queries/graphql_mutation/insert/basic/insert_into_array_col_with_array_input.yaml index e5a4dfc24155d..ef9a556d64368 100644 --- a/server/tests-py/queries/graphql_mutation/insert/basic/insert_into_array_col_with_array_input.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/basic/insert_into_array_col_with_array_input.yaml @@ -5,7 +5,7 @@ data: insert_test_types: returning: - c34_text_array: ["a","b","c"] + - c34_text_array: ["a","b","c"] status: 200 query: variables: diff --git a/server/tests-py/queries/graphql_mutation/insert/geojson/insert_area_less_than_4_points_err.yaml b/server/tests-py/queries/graphql_mutation/insert/geojson/insert_area_less_than_4_points_err.yaml index 517b7bcad22da..68a61c6e73170 100644 --- a/server/tests-py/queries/graphql_mutation/insert/geojson/insert_area_less_than_4_points_err.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/geojson/insert_area_less_than_4_points_err.yaml @@ -5,7 +5,7 @@ response: errors: - extensions: code: parse-failed - path: $.variableValues[0].area.coordinates[0] + path: $.variables.areas[0].area.coordinates[0] message: A LinearRing needs at least 4 Positions query: variables: diff --git a/server/tests-py/queries/graphql_mutation/insert/geojson/insert_geometry_unexpected_type_err.yaml b/server/tests-py/queries/graphql_mutation/insert/geojson/insert_geometry_unexpected_type_err.yaml index 0f1bf95ec1bd7..097f90476a000 100644 --- a/server/tests-py/queries/graphql_mutation/insert/geojson/insert_geometry_unexpected_type_err.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/geojson/insert_geometry_unexpected_type_err.yaml @@ -5,7 +5,7 @@ response: errors: - extensions: code: parse-failed - path: $.variableValues[0].location + path: $.variables.landmarks[0].location message: 'unexpected geometry type: Random' query: variables: diff --git a/server/tests-py/queries/graphql_mutation/insert/geojson/insert_landmark_single_position_err.yaml b/server/tests-py/queries/graphql_mutation/insert/geojson/insert_landmark_single_position_err.yaml index a60c0515d5199..872d5dfc55468 100644 --- a/server/tests-py/queries/graphql_mutation/insert/geojson/insert_landmark_single_position_err.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/geojson/insert_landmark_single_position_err.yaml @@ -4,7 +4,7 @@ status: 400 response: errors: - extensions: - path: '$.variableValues[0].location.coordinates' + path: $.variables.landmarks[0].location.coordinates code: parse-failed message: A Position needs at least 2 elements query: diff --git a/server/tests-py/queries/graphql_mutation/insert/geojson/insert_linear_ring_last_point_not_equal_to_first_err.yaml b/server/tests-py/queries/graphql_mutation/insert/geojson/insert_linear_ring_last_point_not_equal_to_first_err.yaml index 37c03ba7d2b3e..3761ead4eb9a1 100644 --- a/server/tests-py/queries/graphql_mutation/insert/geojson/insert_linear_ring_last_point_not_equal_to_first_err.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/geojson/insert_linear_ring_last_point_not_equal_to_first_err.yaml @@ -5,7 +5,7 @@ response: errors: - extensions: code: parse-failed - path: $.variableValues[0].area.coordinates[0] + path: $.variables.areas[0].area.coordinates[0] message: the first and last locations have to be equal for a LinearRing query: variables: diff --git a/server/tests-py/queries/graphql_mutation/insert/geojson/insert_road_single_point_err.yaml b/server/tests-py/queries/graphql_mutation/insert/geojson/insert_road_single_point_err.yaml index 14be4c276c5a2..b20c45145480e 100644 --- a/server/tests-py/queries/graphql_mutation/insert/geojson/insert_road_single_point_err.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/geojson/insert_road_single_point_err.yaml @@ -4,7 +4,7 @@ status: 400 response: errors: - extensions: - path: $.variableValues[0].path.coordinates + path: $.variables.roads[0].path.coordinates code: parse-failed message: A LineString needs at least 2 Positions query: @@ -17,7 +17,7 @@ query: type: LineString query: | mutation insertRoad($roads: [road_insert_input!]!) { - insert_straight_road(objects: $roads) { + insert_road(objects: $roads) { returning{ id name diff --git a/server/tests-py/test_graphql_mutations.py b/server/tests-py/test_graphql_mutations.py index 9fd55f7a547d2..8b483bdd9e083 100644 --- a/server/tests-py/test_graphql_mutations.py +++ b/server/tests-py/test_graphql_mutations.py @@ -14,7 +14,6 @@ def test_inserts_various_postgres_types(self, hge_ctx): check_query_f(hge_ctx, self.dir() + "/insert_various_postgres_types.yaml") hge_ctx.may_skip_test_teardown = True - @pytest.mark.xfail(reason="Refer https://github.com/hasura/graphql-engine/issues/348") def test_insert_into_array_col_with_array_input(self, hge_ctx): check_query_f(hge_ctx, self.dir() + "/insert_into_array_col_with_array_input.yaml") hge_ctx.may_skip_test_teardown = True From afae0f061012447ed3936453031e8622d6d3ed20 Mon Sep 17 00:00:00 2001 From: Nizar Malangadan Date: Thu, 14 Mar 2019 06:11:15 +0530 Subject: [PATCH 05/13] Boolean expressions _contains and _contained_in for Arrays --- server/src-lib/Hasura/GraphQL/Context.hs | 12 +++++++++--- server/src-lib/Hasura/RQL/GBoolExp.hs | 14 +++++++++----- 2 files changed, 18 insertions(+), 8 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Context.hs b/server/src-lib/Hasura/GraphQL/Context.hs index 3a6f842b05e78..67077621510ef 100644 --- a/server/src-lib/Hasura/GraphQL/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Context.hs @@ -79,7 +79,6 @@ data OpCtx | OCDelete !DelOpCtx deriving (Show, Eq) - data GCtx = GCtx { _gTypes :: !TypeMap @@ -189,7 +188,9 @@ mkCompExpName colTy = -> case getArrayBaseTy t of Nothing -> qualTyToScalar (pgColTyName t) -- Array type - Just b -> T.pack $ show b <> "_" <> show (getPGTyArrDim t) <> "d" + Just b -> case pgColTyDetails b of + PGTyBase bb -> T.pack $ show bb <> "_" <> show (getPGTyArrDim t) <> "d" + _ -> qualTyToScalar (pgColTyName b) mkCompExpTy :: PGColType -> G.NamedType mkCompExpTy = @@ -213,6 +214,7 @@ mkCompExpInp colTy@(PGColType _ _ _ colDtls) = [ map (mkPGTy colTy) typedOps , map (mk (Just $ arrOfCol colTy) $ G.toLT colGQLTy) listOps , bool [] (map (mkPGTy $ baseTy PGText) stringOps) isStringTy + , bool [] (map (mkPGTy colTy) arrOps) isArrTy , bool [] (map jsonbOpToInpVal jsonbOps) isJsonbTy , bool [] (stDWithinOpInpVal : map geomOpToInpVal geomOps) isGeometryTy , [mkPGTyInpVal Nothing "_is_null" $ baseTy PGBoolean] @@ -221,7 +223,7 @@ mkCompExpInp colTy@(PGColType _ _ _ colDtls) = arrOfCol = PTArr . PTCol tyDesc = mconcat [ "expression to compare columns of type " - , G.Description (T.pack $ show colTy) + , G.Description (G.showGT $ mkPGColGTy colTy) , ". All fields are combined with logical 'AND'." ] bTy = case colDtls of @@ -231,6 +233,7 @@ mkCompExpInp colTy@(PGColType _ _ _ colDtls) = Just PGVarchar -> True Just PGText -> True _ -> False + isArrTy = getPGTyArrDim colTy > 0 mk pt t n = InpValInfo Nothing n Nothing pt $ G.toGT t mkPGTy ty = mk (Just $ PTCol ty) $ mkPGColGTy ty colGQLTy = mkPGColGTy colTy @@ -247,6 +250,9 @@ mkCompExpInp colTy@(PGColType _ _ _ colDtls) = , "_similar", "_nsimilar" ] + arrOps = + [ "_contains", "_contained_in"] + isJsonbTy = case bTy of Just PGJSONB -> True _ -> False diff --git a/server/src-lib/Hasura/RQL/GBoolExp.hs b/server/src-lib/Hasura/RQL/GBoolExp.hs index 7b99ccfa767f3..f820a3da78d1d 100644 --- a/server/src-lib/Hasura/RQL/GBoolExp.hs +++ b/server/src-lib/Hasura/RQL/GBoolExp.hs @@ -74,10 +74,10 @@ parseOpExp parser fim (PGColInfo cn colTy _) (opStr, val) = withErrPath $ "_is_null" -> parseIsNull -- jsonb type - "_contains" -> jsonbOnlyOp $ AContains <$> parseOne - "$contains" -> jsonbOnlyOp $ AContains <$> parseOne - "_contained_in" -> jsonbOnlyOp $ AContainedIn <$> parseOne - "$contained_in" -> jsonbOnlyOp $ AContainedIn <$> parseOne + "_contains" -> jsonbOrArrOp $ AContains <$> parseOne + "$contains" -> jsonbOrArrOp $ AContains <$> parseOne + "_contained_in" -> jsonbOrArrOp $ AContainedIn <$> parseOne + "$contained_in" -> jsonbOrArrOp $ AContainedIn <$> parseOne "_has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy (baseTy PGText) "$has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy (baseTy PGText) @@ -155,9 +155,13 @@ parseOpExp parser fim (PGColInfo cn colTy _) (opStr, val) = withErrPath $ parseCgte = CGTE <$> decodeAndValidateRhsCol parseClte = CLTE <$> decodeAndValidateRhsCol + jsonbOrArrOp m + | getPGTyArrDim colTy > 0 = m + | otherwise = jsonbOnlyOp m + jsonbOnlyOp m = case pgColTyDetails colTy of PGTyBase PGJSONB -> m - _ -> throwError $ buildMsg colTy [baseTy PGJSONB] + _ -> throwError $ buildMsg colTy [baseTy PGJSONB] parseGeometryOp f = geometryOnlyOp colTy >> f <$> parseOne From 417f62a05d6ab7fb31ebd3b18528b410ac5deec5 Mon Sep 17 00:00:00 2001 From: Nizar Malangadan Date: Fri, 15 Mar 2019 19:56:01 +0530 Subject: [PATCH 06/13] Support for prepend/append of element/array onto existing array column during SQL update --- .../Hasura/GraphQL/Resolve/Mutation.hs | 67 +++++++++++-------- server/src-lib/Hasura/GraphQL/Schema.hs | 62 +++++++++++++++-- .../src-lib/Hasura/GraphQL/Validate/Types.hs | 2 +- .../src-lib/Hasura/RQL/Types/SchemaCache.hs | 4 ++ server/src-lib/Hasura/SQL/DML.hs | 3 + server/src-lib/Hasura/SQL/Types.hs | 43 +++++++++--- server/src-lib/Hasura/SQL/Value.hs | 16 +++-- 7 files changed, 148 insertions(+), 49 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index 1c6451d1d580a..0ff7de47693b3 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -52,44 +52,44 @@ convertRowObj val = let prepExp = fromMaybe (S.SEUnsafe "NULL") prepExpM return (PGCol $ G.unName k, prepExp) -type ApplySQLOp = (PGCol, S.SQLExp) -> S.SQLExp +type ApplySQLOp = (PGCol, PGColType, S.SQLExp) -> S.SQLExp -rhsExpOp :: S.SQLOp -> AnnType -> ApplySQLOp -rhsExpOp op annTy (col, e) = +rhsExpOp :: S.SQLOp -> (PGColType -> AnnType) -> ApplySQLOp +rhsExpOp op annTyFn (col, ty, e) = S.mkSQLOpExp op (S.SEIden $ toIden col) annExp where - annExp = S.SETyAnn e annTy + annExp = S.SETyAnn e $ annTyFn ty -lhsExpOp :: S.SQLOp -> AnnType -> ApplySQLOp -lhsExpOp op annTy (col, e) = +lhsExpOp :: S.SQLOp -> (PGColType -> AnnType) -> ApplySQLOp +lhsExpOp op annTyFn (col, ty, e) = S.mkSQLOpExp op annExp $ S.SEIden $ toIden col where - annExp = S.SETyAnn e annTy + annExp = S.SETyAnn e $ annTyFn ty convObjWithOp :: (MonadError QErr m) => ApplySQLOp -> AnnGValue -> m [(PGCol, S.SQLExp)] convObjWithOp opFn val = flip withObject val $ \_ obj -> forM (OMap.toList obj) $ \(k, v) -> do - (_, colVal) <- asPGColVal v + (ty, colVal) <- asPGColVal v let pgCol = PGCol $ G.unName k encVal = txtEncoder colVal - sqlExp = opFn (pgCol, encVal) + sqlExp = opFn (pgCol, ty, encVal) return (pgCol, sqlExp) -convDeleteAtPathObj - :: (MonadError QErr m) - => AnnGValue -> m [(PGCol, S.SQLExp)] -convDeleteAtPathObj val = - flip withObject val $ \_ obj -> forM (OMap.toList obj) $ \(k, v) -> do - vals <- flip withArray v $ \_ annVals -> mapM asPGColVal annVals - let valExps = map (txtEncoder . snd) vals - pgCol = PGCol $ G.unName k - annEncVal = S.SETyAnn (S.SEArray valExps) textArrType - sqlExp = S.SEOpApp S.jsonbDeleteAtPathOp - [S.SEIden $ toIden pgCol, annEncVal] - return (pgCol, sqlExp) +--convDeleteAtPathObj +-- :: (MonadError QErr m) +-- => AnnGValue -> m [(PGCol, S.SQLExp)] +--convDeleteAtPathObj val = +-- flip withObject val $ \_ obj -> forM (OMap.toList obj) $ \(k, v) -> do +-- keysArr <- asPGColVal v +-- let valExp = txtEncoder $ snd keysArr +-- pgCol = PGCol $ G.unName k +-- annEncVal = S.SETyAnn valExp textArrType +-- sqlExp = S.SEOpApp S.jsonbDeleteAtPathOp +-- [S.SEIden $ toIden pgCol, annEncVal] +-- return (pgCol, sqlExp) convertUpdate :: UpdOpCtx -- the update context -> Field -- the mutation field @@ -101,27 +101,31 @@ convertUpdate opCtx fld = do whereExp <- withArg args "where" (parseBoolExp prepare) -- increment operator on integer columns incExpM <- withArgM args "_inc" $ - convObjWithOp $ rhsExpOp S.incOp intType + convObjWithOp $ rhsExpOp S.incOp $ const intType -- append jsonb value appendExpM <- withArgM args "_append" $ - convObjWithOp $ rhsExpOp S.jsonbConcatOp jsonbType + convObjWithOp $ rhsExpOp S.jsonbConcatOp $ const jsonbType -- prepend jsonb value prependExpM <- withArgM args "_prepend" $ - convObjWithOp $ lhsExpOp S.jsonbConcatOp jsonbType + convObjWithOp $ lhsExpOp S.jsonbConcatOp $ const jsonbType -- delete a key in jsonb object deleteKeyExpM <- withArgM args "_delete_key" $ - convObjWithOp $ rhsExpOp S.jsonbDeleteOp textType + convObjWithOp $ rhsExpOp S.jsonbDeleteOp $ const textType -- delete an element in jsonb array deleteElemExpM <- withArgM args "_delete_elem" $ - convObjWithOp $ rhsExpOp S.jsonbDeleteOp intType + convObjWithOp $ rhsExpOp S.jsonbDeleteOp $ const intType -- delete at path in jsonb value - deleteAtPathExpM <- withArgM args "_delete_at_path" convDeleteAtPathObj + deleteAtPathExpM <- withArgM args "_delete_at_path" $ + convObjWithOp $ rhsExpOp S.jsonbDeleteAtPathOp $ const textArrType + -- concat operations for array: prepend (or append) element (or array) + arrExpsM <- forM arrUpdExps $ \(op,applySQLOp,annTyFn) -> + withArgM args op $ convObjWithOp $ applySQLOp S.arrConcatOp annTyFn mutFlds <- convertMutResp (_fType fld) $ _fSelSet fld prepArgs <- get let updExpsM = [ setExpM, incExpM, appendExpM, prependExpM , deleteKeyExpM, deleteElemExpM, deleteAtPathExpM - ] + ] <> arrExpsM setItems = preSetItems ++ concat (catMaybes updExpsM) -- atleast one of update operators is expected -- or preSetItems shouldn't be empty @@ -139,6 +143,13 @@ convertUpdate opCtx fld = do UpdOpCtx tn _ filterExp preSetCols uniqCols = opCtx args = _fArguments fld preSetItems = Map.toList preSetCols + getElemTyAnn pct = maybe (pgColTySqlName pct) pgColTySqlName $ getArrayElemTy pct + arrUpdExps = + [ ("_append_array" , rhsExpOp, pgColTySqlName) + , ("_append_element" , rhsExpOp, getElemTyAnn) + , ("_prepend_array" , lhsExpOp, pgColTySqlName) + , ("_prepend_element", lhsExpOp, getElemTyAnn) + ] convertDelete :: DelOpCtx -- the delete context diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index ca046adf8d46a..237a8dddfbbb1 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -653,9 +653,12 @@ mkUpdIncInp tn = maybe Nothing mkType desc = G.Description $ "input type for incrementing integer columne in table " <>> tn +mkArrOpTy :: QualifiedTable -> G.Name -> G.NamedType +mkArrOpTy tn op = + G.NamedType $ qualObjectToName tn <> op <> "_input" + -- table__input mkJSONOpTy :: QualifiedTable -> G.Name -> G.NamedType - mkJSONOpTy tn op = G.NamedType $ qualObjectToName tn <> op <> "_input" @@ -696,6 +699,7 @@ input table_delete_at_path_input { } -} + -- jsonb operators and descriptions prependOp :: G.Name prependOp = "_prepend" @@ -730,6 +734,43 @@ deleteAtPathDesc :: G.Description deleteAtPathDesc = "delete the field or element with specified path" <> " (for JSON arrays, negative integers count from the end)" + +mkUpdArrOpInp :: QualifiedTable -> [PGColInfo] -> [InpObjTyInfo] +mkUpdArrOpInp tn cols = bool arrUpdsInpObjs [] $ null arrCols + where + + arrCols = onlyArrCols cols + + arrUpdsInpObjs = map mkInpTy arrUpdOps + + mkInpTy (opName, desc, f) = mkHsraInpTyInfo (Just desc) (mkArrOpTy tn opName) $ + fromInpValL $ mapMaybe (mkInpVal f) arrCols + + mkInpVal f col = fmap (mkPGTyInpVal Nothing $ G.Name $ getPGColTxt $ pgiName col) $ f (pgiType col) + +arrUpdOps :: [(G.Name, G.Description, PGColType -> Maybe PGColType)] +arrUpdOps = + [ ( "_append_array" + , "append existing array value of filtered columns with new array value" + , Just . id + ) + + , ( "_prepend_array" + , "prepend existing array value of filtered columns with new array value" + , Just . id + ) + + , ( "_append_element" + , "append existing array value of filtered columns with new element value" + , getArrayElemTy + ) + + , ( "_prepend_element" + , "prepend existing array value of filtered columns with new element value" + , getArrayElemTy + ) + ] + mkUpdJSONOpInp :: QualifiedTable -> [PGColInfo] -> [InpObjTyInfo] mkUpdJSONOpInp tn cols = bool inpObjs [] $ null jsonbCols @@ -737,6 +778,7 @@ mkUpdJSONOpInp tn cols = bool inpObjs [] $ null jsonbCols jsonbCols = onlyJSONBCols cols jsonbColNames = map pgiName jsonbCols + inpObjs = [ prependInpObj, appendInpObj, deleteKeyInpObj , deleteElemInpObj, deleteAtPathInpObj ] @@ -762,8 +804,8 @@ mkUpdJSONOpInp tn cols = bool inpObjs [] $ null jsonbCols deleteAtPathInpObj = mkHsraInpTyInfo (Just deleteAtPathDesc) (mkJSONOpTy tn deleteAtPathOp) $ fromInpValL $ map deleteAtPathInpVal jsonbColNames - deleteAtPathInpVal c = InpValInfo Nothing (G.Name $ getPGColTxt c) Nothing (Just $ PTArr $ PTCol $ baseTy PGText) $ - G.toGT $ G.toLT $ mkPGColGTy $ baseTy PGText + deleteAtPathInpVal c = mkPGTyInpVal Nothing (G.Name $ getPGColTxt c) $ + $(arrTyOfBaseQ PGText) {- @@ -787,6 +829,13 @@ mkIncInpVal tn cols = bool (Just incArg) Nothing $ null intCols incArg = InpValInfo (Just incArgDesc) "_inc" Nothing Nothing $ G.toGT $ mkUpdIncTy tn +mkArrOpInpVals :: QualifiedTable -> [PGColInfo] -> [InpValInfo] +mkArrOpInpVals tn cols = bool arrOpArgs [] $ null arrCols + where + arrCols = onlyArrCols cols + arrOpArgs = map mkArg arrUpdOps + mkArg (op,desc,_) = InpValInfo (Just desc) op Nothing Nothing $ G.toGT $ mkArrOpTy tn op + mkJSONOpInpVals :: QualifiedTable -> [PGColInfo] -> [InpValInfo] mkJSONOpInpVals tn cols = bool jsonbOpArgs [] $ null jsonbCols where @@ -818,7 +867,7 @@ mkUpdMutFld tn cols = G.toGT $ mkMutRespTy tn where inputValues = [filterArg, setArg] <> incArg - <> mkJSONOpInpVals tn cols + <> mkJSONOpInpVals tn cols <> mkArrOpInpVals tn cols desc = G.Description $ "update data of the table: " <>> tn fldName = "update_" <> qualObjectToName tn @@ -1274,12 +1323,13 @@ mkGCtxRole' tn allCols insPermM selPermM updColsM updatableCols = maybe [] (map pgiName) updColsM onConflictTypes = mkOnConflictTypes tn constNames updatableCols isUpsertable jsonOpTys = fromMaybe [] updJSONOpInpObjTysM + arrOpTys = fromMaybe [] updArrOpInpObjTysM relInsInpObjTys = maybe [] (map TIInpObj) $ mutHelper viIsInsertable relInsInpObjsM funcInpArgTys = bool [] (map TIInpObj funcArgInpObjs) $ isJust selFldsM - allTypes = relInsInpObjTys <> onConflictTypes <> jsonOpTys + allTypes = relInsInpObjTys <> onConflictTypes <> jsonOpTys <> arrOpTys <> queryTypes <> aggQueryTypes <> mutationTypes <> funcInpArgTys @@ -1326,6 +1376,8 @@ mkGCtxRole' tn allCols insPermM selPermM updColsM -- update increment input type updIncInpObjM = mkUpdIncInp tn updColsM -- update json operator input type + updArrOpInpObjsM = mkUpdArrOpInp tn <$> updColsM + updArrOpInpObjTysM = map TIInpObj <$> updArrOpInpObjsM updJSONOpInpObjsM = mkUpdJSONOpInp tn <$> updColsM updJSONOpInpObjTysM = map TIInpObj <$> updJSONOpInpObjsM -- fields used in set input object diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index 2580ceb5014f2..aa00d570037a8 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -546,7 +546,7 @@ getPGColKind colTy = case pgColTyDetails colTy of _ -> "scalar" mkPGColGTy :: PGColType -> G.GType -mkPGColGTy colTy = case pgColTyDetails colTy of +mkPGColGTy colTy = case pgColTyDetails (getUdt colTy) of PGTyArray t -> G.toGT $ G.toLT $ mkPGColGTy t _ -> G.toGT $ mkScalarTy colTy diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index 816c6afdfed03..877a5caa8aa45 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -15,6 +15,7 @@ module Hasura.RQL.Types.SchemaCache , onlyIntCols , onlyNumCols , onlyJSONBCols + , onlyArrCols , onlyComparableCols , isUniqueOrPrimary , isForeignKey @@ -152,6 +153,9 @@ onlyNumCols = filter (isNumType . pgiType) onlyJSONBCols :: [PGColInfo] -> [PGColInfo] onlyJSONBCols = filter (isJSONBType . pgiType) +onlyArrCols :: [PGColInfo] -> [PGColInfo] +onlyArrCols = filter (isArrType . pgiType) + onlyComparableCols :: [PGColInfo] -> [PGColInfo] onlyComparableCols = filter (isComparableType . pgiType) diff --git a/server/src-lib/Hasura/SQL/DML.hs b/server/src-lib/Hasura/SQL/DML.hs index 27e4475eb95ab..806312803d8f6 100644 --- a/server/src-lib/Hasura/SQL/DML.hs +++ b/server/src-lib/Hasura/SQL/DML.hs @@ -218,6 +218,9 @@ jsonbDeleteOp = SQLOp "-" jsonbDeleteAtPathOp :: SQLOp jsonbDeleteAtPathOp = SQLOp "#-" +arrConcatOp :: SQLOp +arrConcatOp = SQLOp "||" + data CountType = CTStar | CTSimple ![PGCol] diff --git a/server/src-lib/Hasura/SQL/Types.hs b/server/src-lib/Hasura/SQL/Types.hs index 4144cb849b27b..07aee6d92e207 100644 --- a/server/src-lib/Hasura/SQL/Types.hs +++ b/server/src-lib/Hasura/SQL/Types.hs @@ -408,17 +408,21 @@ data PGColTyDetails instance Hashable PGColTyDetails +getArrayElemTy :: PGColType -> Maybe PGColType +getArrayElemTy x = case pgColTyDetails (getUdt x) of + PGTyArray b -> Just b + _ -> Nothing + getArrayBaseTy :: PGColType -> Maybe PGColType -getArrayBaseTy x = case pgColTyDetails x of +getArrayBaseTy x = case pgColTyDetails (getUdt x) of PGTyArray b -> case pgColTyDetails b of PGTyArray{} -> getArrayBaseTy b _ -> Just b _ -> Nothing getPGTyArrDim :: PGColType -> Int -getPGTyArrDim colTy = case pgColTyDetails colTy of +getPGTyArrDim colTy = case pgColTyDetails (getUdt colTy) of PGTyArray bTy -> 1 + getPGTyArrDim bTy - PGTyDomain bTy -> getPGTyArrDim bTy _ -> 0 data PGColType @@ -429,6 +433,12 @@ data PGColType , pgColTyDetails :: !PGColTyDetails } deriving (Show, Eq, TH.Lift, Generic) +-- Get underlying data type when PGColType is a domain +getUdt :: PGColType -> PGColType +getUdt colTy = case pgColTyDetails colTy of + PGTyDomain b -> getUdt b + _ -> colTy + $(deriveJSON defaultOptions { constructorTagModifier = snakeCase . drop 4 , sumEncoding = TaggedObject "type" "detail" @@ -442,6 +452,20 @@ baseTy b = PGColType qualfdType (AnnType name) (pgTypeOid b)$ PGTyBase b qualfdType = QualifiedObject (SchemaName "pg_catalog") (PGTyName name) name = T.pack $ show b +arrTyOfBaseQ :: PGBaseColType -> TH.Q TH.Exp +arrTyOfBaseQ bct = case arrTyOfBase bct of + Nothing -> fail $ "Could not find array type for base type " <> show bct + Just x -> TH.lift x + +arrTyOfBase :: PGBaseColType -> Maybe PGColType +arrTyOfBase bct = case PTI.getArrOidOfElem (PTI.ElemOid bOid) of + Nothing -> Nothing + Just (PTI.ArrOid arrOid) -> return $ PGColType arrQualTy arrSqlName arrOid $ PGTyArray $ baseTy bct + where + bOid = pgTypeOid bct + arrSqlName = AnnType $ T.pack (show bct) <> "[]" + arrQualTy = QualifiedObject catalogSchema $ PGTyName $ "_" <> T.pack (show bct) + instance Hashable PGColType pgTypeOid :: PGBaseColType -> PQ.Oid @@ -477,6 +501,11 @@ isNumType = onBaseUDT False isNumType' isJSONBType :: PGColType -> Bool isJSONBType = onBaseUDT False isJSONBType' +isArrType :: PGColType -> Bool +isArrType colTy = case pgColTyDetails (getUdt colTy) of + PGTyArray{} -> True + _ -> False + pattern PGGeomTy :: QualifiedType -> AnnType -> PQ.Oid -> PGColType pattern PGGeomTy a b c = PGColType a b c (PGTyBase PGGeometry) @@ -485,18 +514,16 @@ pattern PGJSONTy a b c = PGColType a b c (PGTyBase PGJSON) --any numeric, string, date/time, network, or enum type, or arrays of these types isComparableType :: PGColType -> Bool -isComparableType t = case pgColTyDetails t of - PGTyArray a -> isComparableType a - PGTyDomain a -> isComparableType a +isComparableType t = case pgColTyDetails (getUdt t) of + PGTyArray a -> isComparableType a PGTyBase b -> isComparableType' b PGTyEnum{} -> True _ -> False -- Apply the function if the underlying data type is a base data type. Otherwise return the default value onBaseUDT :: a -> (PGBaseColType -> a) -> PGColType -> a -onBaseUDT def f t = case pgColTyDetails t of +onBaseUDT def f t = case pgColTyDetails (getUdt t) of PGTyBase b -> f b - PGTyDomain a -> onBaseUDT def f a _ -> def isIntegerType' :: PGBaseColType -> Bool diff --git a/server/src-lib/Hasura/SQL/Value.hs b/server/src-lib/Hasura/SQL/Value.hs index 39d9de92b2eec..e07d351e8564b 100644 --- a/server/src-lib/Hasura/SQL/Value.hs +++ b/server/src-lib/Hasura/SQL/Value.hs @@ -290,9 +290,7 @@ parsePGValue pct val = case pgColTyDetails pct of PGTyDomain dom -> parsePGValue dom val PGTyComposite{} -> parseAsComposite val PGTyRange{} -> parseAsRange val - PGTyBase pbct -> case val of - String t -> parseAsBase pbct val <|> return (asUnknown pct t) - _ -> parseAsBase pbct val + PGTyBase pbct -> parseAsBase pbct val where parseAsVal :: (FromJSON a) => (a -> PGColValue') -> Value -> AT.Parser PGColValue parseAsVal g v = @@ -302,7 +300,7 @@ parsePGValue pct val = case pgColTyDetails pct of parseAsComposite = parseAsVal PGValComposite parseAsEnum = parseAsVal PGValEnum parseAsRange = parseAsVal PGValRange - parseAsArray bct v = (flip $ withArray "PGValArray (V.Vector PGColValue)") v $ \a -> do + parseAsArray bct v = allowPGEncStr $ (flip $ withArray "[PGColValue]") v $ \a -> do let oid = pgColTyOid pct eOid <- maybe (fail "Array types must return base element type") return $ getArrayBaseTy pct let asArr = PGColValue oid . PGValArray (pgColTyOid eOid) @@ -310,15 +308,19 @@ parsePGValue pct val = case pgColTyDetails pct of asUnknown bct v = PGColValue (pgColTyOid bct) $ PGValBase $ PGValUnknown v - parseAsBase bct v = + parseAsBase bct v = allowPGEncStr $ let oid' = pgTypeOid bct oidCol = pgColTyOid pct - -- For PGUnknown take oid from Column type - -- For PGKnown take from type of PGColValue + -- For PGUnknown take oid from PGColType oid = bool oid' oidCol $ oid' == PTI.auto asBaseColVal = PGColValue oid . PGValBase in fmap asBaseColVal $ parsePGValue' bct v + allowPGEncStr :: AT.Parser PGColValue -> AT.Parser PGColValue + allowPGEncStr f = case val of + String t -> f <|> return (asUnknown pct t) + _ -> f + convToBin :: PGColType -> Value From cfc69c48235a9633becee566e4afb27a3782ea14 Mon Sep 17 00:00:00 2001 From: Nizar Malangadan Date: Wed, 20 Mar 2019 11:51:21 +0530 Subject: [PATCH 07/13] Change _contained_in to _is_contained_by --- server/src-lib/Hasura/GraphQL/Context.hs | 2 +- server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs | 11 ++++++----- server/src-lib/Hasura/RQL/GBoolExp.hs | 11 +++++++---- 3 files changed, 14 insertions(+), 10 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Context.hs b/server/src-lib/Hasura/GraphQL/Context.hs index 67077621510ef..019ad3c821055 100644 --- a/server/src-lib/Hasura/GraphQL/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Context.hs @@ -251,7 +251,7 @@ mkCompExpInp colTy@(PGColType _ _ _ colDtls) = ] arrOps = - [ "_contains", "_contained_in"] + [ "_contains", "_is_contained_by"] isJsonbTy = case bTy of Just PGJSONB -> True diff --git a/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs b/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs index c7afc9a1e0380..823b0de9ec6ec 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs @@ -50,11 +50,12 @@ parseOpExps annVal = do "_nsimilar" -> fmap ANSIMILAR <$> asPGColValM v -- jsonb related operators - "_contains" -> fmap AContains <$> asPGColValM v - "_contained_in" -> fmap AContainedIn <$> asPGColValM v - "_has_key" -> fmap AHasKey <$> asPGColValM v - "_has_keys_any" -> fmap AHasKeysAny <$> parseMany asPGColText v - "_has_keys_all" -> fmap AHasKeysAll <$> parseMany asPGColText v + "_contains" -> fmap AContains <$> asPGColValM v + "_contained_in" -> fmap AContainedIn <$> asPGColValM v + "_is_contained_by" -> fmap AContainedIn <$> asPGColValM v + "_has_key" -> fmap AHasKey <$> asPGColValM v + "_has_keys_any" -> fmap AHasKeysAny <$> parseMany asPGColText v + "_has_keys_all" -> fmap AHasKeysAll <$> parseMany asPGColText v -- geometry type related operators "_st_contains" -> fmap ASTContains <$> asPGColValM v diff --git a/server/src-lib/Hasura/RQL/GBoolExp.hs b/server/src-lib/Hasura/RQL/GBoolExp.hs index f820a3da78d1d..207165e0f47fc 100644 --- a/server/src-lib/Hasura/RQL/GBoolExp.hs +++ b/server/src-lib/Hasura/RQL/GBoolExp.hs @@ -74,10 +74,13 @@ parseOpExp parser fim (PGColInfo cn colTy _) (opStr, val) = withErrPath $ "_is_null" -> parseIsNull -- jsonb type - "_contains" -> jsonbOrArrOp $ AContains <$> parseOne - "$contains" -> jsonbOrArrOp $ AContains <$> parseOne - "_contained_in" -> jsonbOrArrOp $ AContainedIn <$> parseOne - "$contained_in" -> jsonbOrArrOp $ AContainedIn <$> parseOne + "_contains" -> jsonbOrArrOp $ AContains <$> parseOne + "$contains" -> jsonbOrArrOp $ AContains <$> parseOne + "_contained_in" -> jsonbOrArrOp $ AContainedIn <$> parseOne + "$contained_in" -> jsonbOnlyOp $ AContainedIn <$> parseOne + "$is_contained_by" -> jsonbOrArrOp $ AContainedIn <$> parseOne + "_is_contained_by" -> jsonbOrArrOp $ AContainedIn <$> parseOne + "_has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy (baseTy PGText) "$has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy (baseTy PGText) From cb93ebc233494501741775e260e84df94970d761 Mon Sep 17 00:00:00 2001 From: Nizar Malangadan Date: Fri, 22 Mar 2019 19:52:57 +0530 Subject: [PATCH 08/13] Fix insert geography & geometry arrays bug --- .../src-lib/Hasura/GraphQL/Validate/Types.hs | 9 ++- server/src-lib/Hasura/SQL/Rewrite.hs | 6 +- server/src-lib/Hasura/SQL/Types.hs | 59 +++++++++++-------- server/src-lib/Hasura/SQL/Value.hs | 17 ++---- ...nsert_into_array_col_with_array_input.yaml | 40 +++++++++++-- .../graphql_mutation/insert/basic/setup.yaml | 4 +- 6 files changed, 89 insertions(+), 46 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index aa00d570037a8..535adaccf97fe 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -517,9 +517,12 @@ isSubTypeBase subTyInfo supTyInfo = case (subTyInfo,supTyInfo) of notSubTyErr = throwError $ "Type " <> showTy subTyInfo <> " is not a sub type of " <> showTy supTyInfo pgColTyToScalar :: PGColType -> Text -pgColTyToScalar (PGColType qn _ _ d) = case d of - PGTyBase b -> pgBaseColTyToScalar b - _ -> qualTyToScalar qn +pgColTyToScalar t = case (pgColTyName udt, pgColTyDetails udt) of + (_ , PGTyBase b) -> pgBaseColTyToScalar b + (_ , PGTyArray t') -> pgColTyToScalar t' + (qn, _) -> qualTyToScalar qn + where + udt = getUdt t qualTyToScalar :: QualifiedType -> Text qualTyToScalar (QualifiedObject (SchemaName s) n) diff --git a/server/src-lib/Hasura/SQL/Rewrite.hs b/server/src-lib/Hasura/SQL/Rewrite.hs index ef4195167da75..5f13eecce66de 100644 --- a/server/src-lib/Hasura/SQL/Rewrite.hs +++ b/server/src-lib/Hasura/SQL/Rewrite.hs @@ -87,8 +87,10 @@ uFromItem fromItem = case fromItem of S.FISimple t <$> mapM addAlias alM S.FIIden iden -> S.FIIden <$> return iden - S.FIFunc f args alM -> - S.FIFunc f args <$> mapM addAlias alM + S.FIFunc f args alM -> do + newArgs <- mapM uSqlExp args + newAls <- mapM addAlias alM + return $ S.FIFunc f newArgs newAls S.FISelect isLateral sel al -> do -- we are kind of ignoring if we have to reset -- idens to empty based on correlation diff --git a/server/src-lib/Hasura/SQL/Types.hs b/server/src-lib/Hasura/SQL/Types.hs index 07aee6d92e207..e5018d7168e5e 100644 --- a/server/src-lib/Hasura/SQL/Types.hs +++ b/server/src-lib/Hasura/SQL/Types.hs @@ -172,7 +172,7 @@ publicSchema :: SchemaName publicSchema = SchemaName "public" catalogSchema :: SchemaName -catalogSchema = SchemaName "catalog" +catalogSchema = SchemaName "pg_catalog" instance IsIden SchemaName where toIden (SchemaName t) = Iden t @@ -447,7 +447,7 @@ $(deriveJSON $(deriveJSON (aesonDrop 7 camelCase) ''PGColType) baseTy :: PGBaseColType -> PGColType -baseTy b = PGColType qualfdType (AnnType name) (pgTypeOid b)$ PGTyBase b +baseTy b = PGColType qualfdType (AnnType name) (pgBaseTyOid b)$ PGTyBase b where qualfdType = QualifiedObject (SchemaName "pg_catalog") (PGTyName name) name = T.pack $ show b @@ -462,34 +462,45 @@ arrTyOfBase bct = case PTI.getArrOidOfElem (PTI.ElemOid bOid) of Nothing -> Nothing Just (PTI.ArrOid arrOid) -> return $ PGColType arrQualTy arrSqlName arrOid $ PGTyArray $ baseTy bct where - bOid = pgTypeOid bct + bOid = pgBaseTyOid bct arrSqlName = AnnType $ T.pack (show bct) <> "[]" arrQualTy = QualifiedObject catalogSchema $ PGTyName $ "_" <> T.pack (show bct) instance Hashable PGColType -pgTypeOid :: PGBaseColType -> PQ.Oid -pgTypeOid PGSmallInt = PTI.int2 -pgTypeOid PGInteger = PTI.int4 -pgTypeOid PGBigInt = PTI.int8 -pgTypeOid PGSerial = PTI.int4 -pgTypeOid PGBigSerial = PTI.int8 -pgTypeOid PGFloat = PTI.float4 -pgTypeOid PGDouble = PTI.float8 -pgTypeOid PGNumeric = PTI.numeric -pgTypeOid PGBoolean = PTI.bool -pgTypeOid PGChar = PTI.char -pgTypeOid PGVarchar = PTI.varchar -pgTypeOid PGText = PTI.text -pgTypeOid PGDate = PTI.date -pgTypeOid PGTimeStampTZ = PTI.timestamptz -pgTypeOid PGTimeTZ = PTI.timetz -pgTypeOid PGJSON = PTI.json -pgTypeOid PGJSONB = PTI.jsonb +pgTyOid :: PGColType -> PQ.Oid +pgTyOid ct = case pgColTyDetails (getUdt ct) of + PGTyBase bt -> let tryOid = pgBaseTyOid bt in + bool origOid tryOid $ tryOid /= PTI.auto + PGTyArray bt -> case PTI.getArrOidOfElem (PTI.ElemOid $ pgTyOid bt) of + Nothing -> origOid + Just (PTI.ArrOid oid) -> oid + _ -> origOid + where + origOid = pgColTyOid ct + +pgBaseTyOid :: PGBaseColType -> PQ.Oid +pgBaseTyOid PGSmallInt = PTI.int2 +pgBaseTyOid PGInteger = PTI.int4 +pgBaseTyOid PGBigInt = PTI.int8 +pgBaseTyOid PGSerial = PTI.int4 +pgBaseTyOid PGBigSerial = PTI.int8 +pgBaseTyOid PGFloat = PTI.float4 +pgBaseTyOid PGDouble = PTI.float8 +pgBaseTyOid PGNumeric = PTI.numeric +pgBaseTyOid PGBoolean = PTI.bool +pgBaseTyOid PGChar = PTI.char +pgBaseTyOid PGVarchar = PTI.varchar +pgBaseTyOid PGText = PTI.text +pgBaseTyOid PGDate = PTI.date +pgBaseTyOid PGTimeStampTZ = PTI.timestamptz +pgBaseTyOid PGTimeTZ = PTI.timetz +pgBaseTyOid PGJSON = PTI.json +pgBaseTyOid PGJSONB = PTI.jsonb -- we are using the ST_GeomFromGeoJSON($i) instead of $i -pgTypeOid PGGeometry = PTI.text -pgTypeOid PGGeography = PTI.text -pgTypeOid (PGUnknown _) = PTI.auto +pgBaseTyOid PGGeometry = PTI.text +pgBaseTyOid PGGeography = PTI.text +pgBaseTyOid (PGUnknown _) = PTI.auto isIntegerType :: PGColType -> Bool diff --git a/server/src-lib/Hasura/SQL/Value.hs b/server/src-lib/Hasura/SQL/Value.hs index e07d351e8564b..9d58bd671edb7 100644 --- a/server/src-lib/Hasura/SQL/Value.hs +++ b/server/src-lib/Hasura/SQL/Value.hs @@ -1,7 +1,6 @@ {-# LANGUAGE PatternSynonyms #-} module Hasura.SQL.Value where - import Hasura.SQL.GeoJSON import Hasura.SQL.Time import Hasura.SQL.Types @@ -301,19 +300,14 @@ parsePGValue pct val = case pgColTyDetails pct of parseAsEnum = parseAsVal PGValEnum parseAsRange = parseAsVal PGValRange parseAsArray bct v = allowPGEncStr $ (flip $ withArray "[PGColValue]") v $ \a -> do - let oid = pgColTyOid pct - eOid <- maybe (fail "Array types must return base element type") return $ getArrayBaseTy pct - let asArr = PGColValue oid . PGValArray (pgColTyOid eOid) + let elemOid = maybe (pgColTyOid bct) pgTyOid $ getArrayBaseTy pct + asArr = PGColValue (pgTyOid pct) . PGValArray elemOid fmap asArr $ mapM (parsePGValue bct) a asUnknown bct v = PGColValue (pgColTyOid bct) $ PGValBase $ PGValUnknown v parseAsBase bct v = allowPGEncStr $ - let oid' = pgTypeOid bct - oidCol = pgColTyOid pct - -- For PGUnknown take oid from PGColType - oid = bool oid' oidCol $ oid' == PTI.auto - asBaseColVal = PGColValue oid . PGValBase in + let asBaseColVal = PGColValue (pgTyOid pct) . PGValBase in fmap asBaseColVal $ parsePGValue' bct v allowPGEncStr :: AT.Parser PGColValue -> AT.Parser PGColValue @@ -394,12 +388,11 @@ applyAsGeoJSONArr v = toPrepParam :: Int -> PGColType -> S.SQLExp toPrepParam i ty = withGeom ty $ S.SEPrep i - where withGeom :: PGColType -> S.SQLExp -> S.SQLExp -withGeom (PGColType _ _ _ d) = case d of +withGeom ty@(PGColType _ _ _ d) = case d of PGTyBase x -> bool id applyGeomFromGeoJson $ isBaseTyGeo x - PGTyArray a -> case getArrayBaseTy a of + PGTyArray{} -> case getArrayBaseTy ty of Just (PGColType _ _ _ (PGTyBase b)) -> bool id applyArrGeomFromGeoJson $ isBaseTyGeo b _ -> id _ -> id diff --git a/server/tests-py/queries/graphql_mutation/insert/basic/insert_into_array_col_with_array_input.yaml b/server/tests-py/queries/graphql_mutation/insert/basic/insert_into_array_col_with_array_input.yaml index ef9a556d64368..4b57411d65c9a 100644 --- a/server/tests-py/queries/graphql_mutation/insert/basic/insert_into_array_col_with_array_input.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/basic/insert_into_array_col_with_array_input.yaml @@ -1,28 +1,60 @@ #Inserting data into test_types table -- description: Inserts Array into an Array column +- description: Inserts Arrays into an Array columns url: /v1alpha1/graphql response: data: insert_test_types: returning: - - c34_text_array: ["a","b","c"] + - c34_text_array: &text_arr + ["\"a\\\"","'b'","c"] + c35_integer_2d_array: &int_arr + - [1,2,3,4] + - [5,6,7,8] + - [9,10,11,12] + c45_geom_array: &geom_arr + - coordinates: [43.75049, 11.03207] + type: Point + crs: &crs + type: name + properties: + name: 'urn:ogc:def:crs:EPSG::4326' + - coordinates: [43.76417, 11.25869] + type: Point + crs: *crs + c46_range_numeric_array: &range_arr + - '[123,456)' + - '[142,225]' + - '(241,325)' + - '(242,526]' status: 200 query: variables: - textArray: ["a","b","c"] + textArray: *text_arr + intArray: *int_arr + geomArray: *geom_arr + rangeArray: *range_arr query: | mutation insert_test_types - ($textArray: [String]) + ( $textArray: [String] + , $geomArray: [json] + , $intArray: [[Int]] + , $rangeArray:[numrange] ) { insert_test_types( objects: [ { c34_text_array: $textArray + c35_integer_2d_array: $intArray + c45_geom_array: $geomArray + c46_range_numeric_array: $rangeArray } ] ) { returning { c34_text_array + c35_integer_2d_array + c45_geom_array + c46_range_numeric_array } } } diff --git a/server/tests-py/queries/graphql_mutation/insert/basic/setup.yaml b/server/tests-py/queries/graphql_mutation/insert/basic/setup.yaml index 73ef7433cd8ff..31f032d687cb4 100644 --- a/server/tests-py/queries/graphql_mutation/insert/basic/setup.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/basic/setup.yaml @@ -142,7 +142,9 @@ args: c41_range_numeric numrange, c42_range_timestamp tsrange, c43_range_timestamptz tstzrange, - c44_xml xml + c44_xml xml, + c45_geom_array geometry(Point)[], + c46_range_numeric_array numrange[] ); - type: track_table args: From 1c6761275c5d045b430fd8816db79c7cbb1b681f Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Thu, 16 May 2019 16:59:29 +0530 Subject: [PATCH 09/13] don't store pg type info in cache --- .../src-lib/Hasura/RQL/DDL/Schema/Function.hs | 27 +-- .../src-lib/Hasura/RQL/DDL/Schema/PGType.hs | 154 +++++++++--------- server/src-lib/Hasura/RQL/DDL/Schema/Table.hs | 48 +++--- server/src-lib/Hasura/RQL/Types/Common.hs | 14 +- .../src-lib/Hasura/RQL/Types/SchemaCache.hs | 14 +- 5 files changed, 141 insertions(+), 116 deletions(-) diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Function.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Function.hs index ca99d8099404e..5071b19f9e54f 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Function.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Function.hs @@ -2,9 +2,9 @@ module Hasura.RQL.DDL.Schema.Function where import Hasura.GraphQL.Utils (isValidName, showNames) import Hasura.Prelude +import Hasura.RQL.DDL.Schema.PGType import Hasura.RQL.Types import Hasura.SQL.Types -import Hasura.RQL.DDL.Schema.PGType import Data.Aeson import Data.Aeson.Casing @@ -63,8 +63,10 @@ validateFuncArgs args = funcArgsText = mapMaybe (fmap getFuncArgNameTxt . faName) args invalidArgs = filter (not . isValidName) $ map G.Name funcArgsText -mkFunctionInfo :: (QErrM m, CacheRWM m, MonadTx m) => QualifiedFunction -> RawFuncInfo -> m FunctionInfo -mkFunctionInfo qf rawFuncInfo = do +mkFunctionInfo + :: (QErrM m, CacheRWM m, MonadTx m) + => PGTyInfoMaps -> QualifiedFunction -> RawFuncInfo -> m FunctionInfo +mkFunctionInfo tyMaps qf rawFuncInfo = do -- throw error if function has variadic arguments when hasVariadic $ throw400 NotSupported "function with \"VARIADIC\" parameters are not supported" -- throw error if return type is not composite type @@ -76,7 +78,7 @@ mkFunctionInfo qf rawFuncInfo = do -- throw error if function type is VOLATILE when (funTy == FTVOLATILE) $ throw400 NotSupported "function of type \"VOLATILE\" is not supported now" - inpArgTyps <- toPGColTysWithCaching inpArgOids + inpArgTyps <- resolveColTypes tyMaps inpArgOids let funcArgs = mkFunctionArgs inpArgTyps inpArgNames validateFuncArgs funcArgs @@ -92,8 +94,10 @@ mkFunctionInfo qf rawFuncInfo = do -- Build function info -getFunctionInfo :: (QErrM m, CacheRWM m, MonadTx m) => QualifiedFunction -> m FunctionInfo -getFunctionInfo qf@(QualifiedObject sn fn) = do +getFunctionInfo + :: (QErrM m, CacheRWM m, MonadTx m) + => PGTyInfoMaps -> QualifiedFunction -> m FunctionInfo +getFunctionInfo tyMaps qf@(QualifiedObject sn fn) = do -- fetch function details funcData <- liftTx $ Q.catchE defaultTxErrorHandler $ Q.listQ $(Q.sqlFromFile "src-rsr/function_info.sql") (sn, fn) True @@ -101,7 +105,7 @@ getFunctionInfo qf@(QualifiedObject sn fn) = do case funcData of [] -> throw400 NotExists $ "no such function exists in postgres : " <>> qf - [Identity (Q.AltJ rawFuncInfo)] -> mkFunctionInfo qf rawFuncInfo + [Identity (Q.AltJ rawFuncInfo)] -> mkFunctionInfo tyMaps qf rawFuncInfo _ -> throw400 NotSupported $ "function " <> qf <<> " is overloaded. Overloaded functions are not supported" @@ -134,9 +138,9 @@ trackFunctionP1 (TrackFunction qf) = do throw400 AlreadyTracked $ "function already tracked : " <>> qf trackFunctionP2Setup :: (QErrM m, CacheRWM m, MonadTx m) - => QualifiedFunction -> m () -trackFunctionP2Setup qf = do - fi <- withPathK "name" $ getFunctionInfo qf + => PGTyInfoMaps -> QualifiedFunction -> m () +trackFunctionP2Setup tyMaps qf = do + fi <- withPathK "name" $ getFunctionInfo tyMaps qf let retTable = fiReturnType fi err = err400 NotExists $ "table " <> retTable <<> " is not tracked" sc <- askSchemaCache @@ -154,7 +158,8 @@ trackFunctionP2 qf = do "function name " <> qf <<> " is not in compliance with GraphQL spec" -- check for conflicts in remote schema GS.checkConflictingNode defGCtx funcNameGQL - trackFunctionP2Setup qf + tyMaps <- liftTx getPGTyInfoMap + trackFunctionP2Setup tyMaps qf liftTx $ saveFunctionToCatalog qf False return successMsg diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs b/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs index d0128f95742df..b64b8a08854d3 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs @@ -5,10 +5,10 @@ import Hasura.RQL.Types import Hasura.SQL.Types -import qualified Data.HashSet as Set -import qualified Data.HashMap.Strict as Map -import qualified Data.Text as T -import qualified Database.PG.Query as Q +import qualified Data.HashMap.Strict as Map +import qualified Data.HashSet as Set +import qualified Data.Text as T +import qualified Database.PG.Query as Q getPGTyInfoMap :: Q.TxE QErr PGTyInfoMaps @@ -17,81 +17,85 @@ getPGTyInfoMap = do Q.listQ $(Q.sqlFromFile "src-rsr/pg_type_info.sql") () True return $ mkPGTyMaps $ map (Q.getAltJ . runIdentity) pgTyInfo -toPGColTysWithCaching :: (QErrM m, CacheRWM m, MonadTx m) => [PGColOidInfo] -> m [PGColType] -toPGColTysWithCaching oids = do - curTysCache <- addPGTysToCache $ Set.fromList oids - forM oids $ \oid -> onNothing (Map.lookup oid curTysCache) $ throw500 $ - "Could not find Postgres type with oid info" <> T.pack (show oid) +-- toPGColTysWithCaching :: (QErrM m, CacheRWM m, MonadTx m) => [PGColOidInfo] -> m [PGColType] +-- toPGColTysWithCaching oids = do +-- curTysCache <- addPGTysToCache $ Set.fromList oids +-- forM oids $ \oid -> onNothing (Map.lookup oid curTysCache) $ throw500 $ +-- "Could not find Postgres type with oid info" <> T.pack (show oid) -getPGColTysMap :: Set.HashSet PGColOidInfo -> Q.TxE QErr (Map.HashMap PGColOidInfo PGColType) -getPGColTysMap ctis = do - tim <- getPGTyInfoMap - fmap Map.fromList $ forM (Set.toList ctis) $ \x -> fmap ((,) x) $ onNothing (getPGColTy tim x) $ errMsg x - where - errMsg x = throw500 $ "Could not find Postgres type for oid " <> T.pack (show $ pcoiOid x) +-- getPGColTysMap +-- :: (QErrM m) +-- => Set.HashSet PGColOidInfo +-- -> PGTyInfoMaps +-- -> m (Map.HashMap PGColOidInfo PGColType) +-- getPGColTysMap ctis tim = +-- -- tim <- getPGTyInfoMap +-- fmap Map.fromList $ forM (Set.toList ctis) $ \x -> fmap ((,) x) $ onNothing (getPGColTy tim x) $ errMsg x +-- where +-- errMsg x = throw500 $ "Could not find Postgres type for oid " <> T.pack (show $ pcoiOid x) -- Do a union of given types and the required types from pg_catalog -addPGTysToCache :: (QErrM m, CacheRWM m, MonadTx m) => Set.HashSet PGColOidInfo -> m (Map.HashMap PGColOidInfo PGColType) -addPGTysToCache i = do - tysCache <- fmap scTyMap askSchemaCache - let inCache x = isJust $ Map.lookup x tysCache - if (all inCache i) - then return tysCache - else updatePGTysCache i +-- addPGTysToCache :: (QErrM m, CacheRWM m, MonadTx m) => Set.HashSet PGColOidInfo -> m (Map.HashMap PGColOidInfo PGColType) +-- addPGTysToCache i = do +-- tysCache <- fmap scTyMap askSchemaCache +-- let inCache x = isJust $ Map.lookup x tysCache +-- if (all inCache i) +-- then return tysCache +-- else updatePGTysCache i -updatePGTysCache :: (CacheRWM m, MonadTx m) => Set.HashSet PGColOidInfo -> m (Map.HashMap PGColOidInfo PGColType) -updatePGTysCache iTys = do - cTys <- liftTx $ getCatalogTys - updTysMap <- liftTx $ getPGColTysMap $ Set.union cTys iTys - modPGTyCache updTysMap - return updTysMap +-- updatePGTysCache :: (CacheRWM m, MonadTx m) => Set.HashSet PGColOidInfo -> m (Map.HashMap PGColOidInfo PGColType) +-- updatePGTysCache iTys = do +-- cTys <- liftTx $ getCatalogTys +-- updTysMap <- liftTx $ getPGColTysMap undefined $ Set.union cTys iTys +-- modPGTyCache updTysMap +-- return updTysMap -getCatalogTys :: Q.TxE QErr (Set.HashSet PGColOidInfo) -getCatalogTys = do - res <- Q.catchE defaultTxErrorHandler $ Q.listQ [Q.sql| - SELECT - ft.argOid :: int as oid, - case - when elemTy.oid is not null - then 1 - else 0 - end as dims - FROM - ( - SELECT DISTINCT unnest(COALESCE(pp.proallargtypes, pp.proargtypes::oid[])) as argOid - FROM - hdb_catalog.hdb_function hp - left outer join pg_proc pp - on - ( hp.function_name = pp.proname and - hp.function_schema = pp.pronamespace::regnamespace::text - ) - ) ft - left outer join pg_type elemTy - on ft.argOid = elemTy.typarray +-- getCatalogTys :: Q.TxE QErr (Set.HashSet PGColOidInfo) +-- getCatalogTys = do +-- res <- Q.catchE defaultTxErrorHandler $ Q.listQ [Q.sql| +-- SELECT +-- ft.argOid :: int as oid, +-- case +-- when elemTy.oid is not null +-- then 1 +-- else 0 +-- end as dims +-- FROM +-- ( +-- SELECT DISTINCT unnest(COALESCE(pp.proallargtypes, pp.proargtypes::oid[])) as argOid +-- FROM +-- hdb_catalog.hdb_function hp +-- left outer join pg_proc pp +-- on +-- ( hp.function_name = pp.proname and +-- hp.function_schema = pp.pronamespace::regnamespace::text +-- ) +-- ) ft +-- left outer join pg_type elemTy +-- on ft.argOid = elemTy.typarray - UNION +-- UNION - SELECT DISTINCT - td.atttypid :: int as oid, - td.attndims as dims - FROM - hdb_catalog.hdb_table ht - left outer join information_schema.columns c - on ht.table_schema = c.table_schema and ht.table_name = c.table_name - left outer join ( - select pc.relnamespace, - pc.relname, - pa.attname, - pa.attndims, - pa.atttypid - from pg_attribute pa - left join pg_class pc - on pa.attrelid = pc.oid - ) td on - ( c.table_schema::regnamespace::oid = td.relnamespace - AND c.table_name = td.relname - AND c.column_name = td.attname - ) - |] () False - return $ Set.fromList $ flip map res $ \(oid, dims) -> PGColOidInfo oid (fromIntegral (dims :: Int)) +-- SELECT DISTINCT +-- td.atttypid :: int as oid, +-- td.attndims as dims +-- FROM +-- hdb_catalog.hdb_table ht +-- left outer join information_schema.columns c +-- on ht.table_schema = c.table_schema and ht.table_name = c.table_name +-- left outer join ( +-- select pc.relnamespace, +-- pc.relname, +-- pa.attname, +-- pa.attndims, +-- pa.atttypid +-- from pg_attribute pa +-- left join pg_class pc +-- on pa.attrelid = pc.oid +-- ) td on +-- ( c.table_schema::regnamespace::oid = td.relnamespace +-- AND c.table_name = td.relname +-- AND c.column_name = td.attname +-- ) +-- |] () False +-- return $ Set.fromList $ flip map res $ \(oid, dims) -> PGColOidInfo oid (fromIntegral (dims :: Int)) diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs index a407b9ddc6262..b222250bce712 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs @@ -47,22 +47,25 @@ saveTableToCatalog (QualifiedObject sn tn) = |] (sn, tn) False -- Build the TableInfo with all its columns -getTableInfo :: (QErrM m, CacheRWM m, MonadTx m) => - QualifiedTable -> Bool -> m TableInfo -getTableInfo qt@(QualifiedObject sn tn) isSystemDefined = do +getTableInfo + :: (QErrM m, CacheRWM m, MonadTx m) + => PGTyInfoMaps -> QualifiedTable -> Bool -> m TableInfo +getTableInfo tyMaps qt@(QualifiedObject sn tn) isSystemDefined = do tableData <- liftTx $ Q.catchE defaultTxErrorHandler $ Q.listQ $(Q.sqlFromFile "src-rsr/table_info.sql")(sn, tn) True case tableData of [] -> throw400 NotExists $ "no such table/view exists in postgres : " <>> qt [(Q.AltJ cols', Q.AltJ cons, Q.AltJ viewInfoM)] -> do - cols <- toPGColTypes cols' + cols <- toPGColTypes tyMaps cols' return $ mkTableInfo qt isSystemDefined cons cols viewInfoM _ -> throw500 $ "more than one row found for: " <>> qt -toPGColTypes :: (CacheRWM m, MonadTx m) => [PGColInfo'] -> m [PGColInfo] -toPGColTypes cols' = do +toPGColTypes + :: (CacheRWM m, MonadTx m) + => PGTyInfoMaps -> [PGColInfo'] -> m [PGColInfo] +toPGColTypes tyMaps cols' = do let colOids' = map pgipType cols' - pgTysMap <- zip cols' <$> toPGColTysWithCaching colOids' + pgTysMap <- zip cols' <$> resolveColTypes tyMaps colOids' return $ flip map pgTysMap $ \(PGColInfo' na _ nu,pgColTy) -> PGColInfo na pgColTy nu @@ -81,9 +84,9 @@ trackExistingTableOrViewP1 (TrackTable vn) = do trackExistingTableOrViewP2Setup :: (QErrM m, CacheRWM m, MonadTx m) - => QualifiedTable -> Bool -> m () -trackExistingTableOrViewP2Setup tn isSystemDefined = do - ti <- getTableInfo tn isSystemDefined + => PGTyInfoMaps -> QualifiedTable -> Bool -> m () +trackExistingTableOrViewP2Setup tyMaps tn isSystemDefined = do + ti <- getTableInfo tyMaps tn isSystemDefined addTableToCache ti trackExistingTableOrViewP2 @@ -95,7 +98,9 @@ trackExistingTableOrViewP2 vn isSystemDefined = do tn = GS.qualObjectToName vn GS.checkConflictingNode defGCtx tn - trackExistingTableOrViewP2Setup vn isSystemDefined + tyMaps <- liftTx getPGTyInfoMap + + trackExistingTableOrViewP2Setup tyMaps vn isSystemDefined liftTx $ Q.catchE defaultTxErrorHandler $ saveTableToCatalog vn @@ -140,8 +145,8 @@ purgeDep schemaObjId = case schemaObjId of "unexpected dependent object : " <> reportSchemaObj schemaObjId processTableChanges :: (MonadTx m, CacheRWM m) - => TableInfo -> TableDiff -> m Bool -processTableChanges ti tableDiff = do + => PGTyInfoMaps -> TableInfo -> TableDiff -> m Bool +processTableChanges tyMaps ti tableDiff = do -- If table rename occurs then don't replace constraints and -- process dropped/added columns, because schema reload happens eventually sc <- askSchemaCache @@ -180,7 +185,7 @@ processTableChanges ti tableDiff = do procAddedCols tn = do -- In the newly added columns check that there is no conflict with relationships - addedCols <- toPGColTypes addedCols' + addedCols <- toPGColTypes tyMaps addedCols' forM_ addedCols $ \pci@(PGColInfo colName _ _) -> case M.lookup (fromPGCol colName) $ tiFieldInfoMap ti of Just (FIRelationship _) -> @@ -223,8 +228,8 @@ delTableAndDirectDeps qtn@(QualifiedObject sn tn) = do delTableFromCatalog qtn delTableFromCache qtn -processSchemaChanges :: (MonadTx m, CacheRWM m) => SchemaDiff -> m Bool -processSchemaChanges schemaDiff = do +processSchemaChanges :: (MonadTx m, CacheRWM m) => PGTyInfoMaps -> SchemaDiff -> m Bool +processSchemaChanges tyMaps schemaDiff = do -- Purge the dropped tables mapM_ delTableAndDirectDeps droppedTables @@ -233,7 +238,7 @@ processSchemaChanges schemaDiff = do ti <- case M.lookup oldQtn $ scTables sc of Just ti -> return ti Nothing -> throw500 $ "old table metadata not found in cache : " <>> oldQtn - processTableChanges ti tableDiff + processTableChanges tyMaps ti tableDiff where SchemaDiff droppedTables alteredTables = schemaDiff @@ -301,13 +306,14 @@ buildSchemaCache = do -- clean hdb_views liftTx $ Q.catchE defaultTxErrorHandler clearHdbViews -- reset the current schemacache + tyMaps <- liftTx getPGTyInfoMap writeSchemaCache emptySchemaCache hMgr <- askHttpManager strfyNum <- stringifyNum <$> askSQLGenCtx tables <- liftTx $ Q.catchE defaultTxErrorHandler fetchTables forM_ tables $ \(sn, tn, isSystemDefined) -> modifyErr (\e -> "table " <> tn <<> "; " <> e) $ - trackExistingTableOrViewP2Setup (QualifiedObject sn tn) isSystemDefined + trackExistingTableOrViewP2Setup tyMaps (QualifiedObject sn tn) isSystemDefined -- Fetch all the relationships relationships <- liftTx $ Q.catchE defaultTxErrorHandler fetchRelationships @@ -352,7 +358,7 @@ buildSchemaCache = do functions <- liftTx $ Q.catchE defaultTxErrorHandler fetchFunctions forM_ functions $ \(sn, fn) -> modifyErr (\e -> "function " <> fn <<> "; " <> e) $ - trackFunctionP2Setup (QualifiedObject sn fn) + trackFunctionP2Setup tyMaps (QualifiedObject sn fn) -- remote schemas res <- liftTx fetchRemoteSchemas @@ -495,8 +501,10 @@ execWithMDCheck (RunSQL t cascade _) = do throw400 NotSupported $ "type of function " <> qf <<> " is altered to \"VOLATILE\" which is not supported now" + tyMaps <- liftTx getPGTyInfoMap + -- update the schema cache and hdb_catalog with the changes - reloadRequired <- processSchemaChanges schemaDiff + reloadRequired <- processSchemaChanges tyMaps schemaDiff let withReload = buildSchemaCache withoutReload = do diff --git a/server/src-lib/Hasura/RQL/Types/Common.hs b/server/src-lib/Hasura/RQL/Types/Common.hs index c22542810a025..432ecf5882155 100644 --- a/server/src-lib/Hasura/RQL/Types/Common.hs +++ b/server/src-lib/Hasura/RQL/Types/Common.hs @@ -22,13 +22,14 @@ module Hasura.RQL.Types.Common , PGTyInfoMaps , PGColOidInfo(..) , PGTyInfo(..) - , getPGColTy + , resolveColTypes , ColVals , PreSetCols , MutateResp(..) ) where import Hasura.Prelude +import Hasura.RQL.Types.Error import qualified Hasura.SQL.DML as S import Hasura.SQL.Types @@ -76,8 +77,8 @@ data PGTyInfo data PGColOidInfo = PGColOidInfo - { pcoiOid :: PQ.Oid - , pcoiDimension :: Integer + { pcoiOid :: PQ.Oid + , pcoiDimension :: Integer } deriving (Show, Eq, Generic) instance Hashable PGColOidInfo @@ -114,6 +115,13 @@ getPGColTy maps@(oidNameMap,nameTyMap) (PGColOidInfo oid dims) = do getTyOfOid = (flip Map.lookup oidNameMap) >=> (flip Map.lookup nameTyMap) getSubTy = getPGColTy maps +resolveColTypes + :: MonadError QErr m => PGTyInfoMaps -> [PGColOidInfo] -> m [PGColType] +resolveColTypes maps tys = + forM tys $ \t -> onNothing (getPGColTy maps t) $ throw500 $ errMsg t + where + errMsg x = + "Could not find Postgres type for oid " <> T.pack (show $ pcoiOid x) $(deriveJSON (aesonDrop 4 snakeCase) ''PGColOidInfo) $(deriveJSON diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index 877a5caa8aa45..dcaff0795fe17 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -22,7 +22,7 @@ module Hasura.RQL.Types.SchemaCache , mkTableInfo , addTableToCache , modTableInCache - , modPGTyCache + -- , modPGTyCache , delTableFromCache , WithDeps @@ -461,7 +461,7 @@ data SchemaCache , scGCtxMap :: !GC.GCtxMap , scDefaultRemoteGCtx :: !GC.GCtx , scDepMap :: !DepMap - , scTyMap :: !PGTyCache + -- , scTyMap :: !PGTyCache } deriving (Show, Eq) $(deriveToJSON (aesonDrop 2 snakeCase) ''SchemaCache) @@ -525,17 +525,17 @@ delQTemplateFromCache qtn = do emptySchemaCache :: SchemaCache emptySchemaCache = - SchemaCache (M.fromList []) M.empty (M.fromList []) M.empty M.empty GC.emptyGCtx mempty mempty + SchemaCache (M.fromList []) M.empty (M.fromList []) M.empty M.empty GC.emptyGCtx mempty modTableCache :: (CacheRWM m) => TableCache -> m () modTableCache tc = do sc <- askSchemaCache writeSchemaCache $ sc { scTables = tc } -modPGTyCache :: (CacheRWM m) => PGTyCache -> m () -modPGTyCache tm = do - sc <- askSchemaCache - writeSchemaCache $ sc { scTyMap = tm } +-- modPGTyCache :: (CacheRWM m) => PGTyCache -> m () +-- modPGTyCache tm = do +-- sc <- askSchemaCache +-- writeSchemaCache $ sc { scTyMap = tm } addTableToCache :: (QErrM m, CacheRWM m) From b2a8f2c3b24fc1b3054b5aed6b23c52eda64dfcf Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Sun, 19 May 2019 03:00:34 +0530 Subject: [PATCH 10/13] bump catalog to 17 --- server/graphql-engine.cabal | 1 - server/src-exec/Migrate.hs | 14 +- .../Hasura/GraphQL/Resolve/InputValue.hs | 38 --- .../src-lib/Hasura/GraphQL/Resolve/Insert.hs | 3 - .../src-lib/Hasura/RQL/DDL/Schema/Function.hs | 11 +- .../src-lib/Hasura/RQL/DDL/Schema/PGType.hs | 12 - server/src-lib/Hasura/RQL/DDL/Schema/Table.hs | 5 +- server/src-lib/Hasura/RQL/Types/Catalog.hs | 1 + server/src-lib/Hasura/SQL/Value.hs | 11 - server/src-rsr/catalog_metadata.sql | 8 +- server/src-rsr/function_info.sql | 46 --- server/src-rsr/initialise.sql | 89 +++++- server/src-rsr/migrate_from_16_to_17.sql | 267 ++++++++++++++++++ server/src-rsr/pg_type_info.sql | 70 ----- server/src-rsr/table_info.sql | 111 -------- 15 files changed, 383 insertions(+), 304 deletions(-) delete mode 100644 server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs delete mode 100644 server/src-rsr/function_info.sql create mode 100644 server/src-rsr/migrate_from_16_to_17.sql delete mode 100644 server/src-rsr/pg_type_info.sql delete mode 100644 server/src-rsr/table_info.sql diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index b6dce6a6ae3af..fae144b14c982 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -189,7 +189,6 @@ library , Hasura.RQL.DDL.Relationship.Types , Hasura.RQL.DDL.QueryTemplate , Hasura.RQL.DDL.Schema.Table - , Hasura.RQL.DDL.Schema.PGType , Hasura.RQL.DDL.Schema.Rename , Hasura.RQL.DDL.Schema.Function , Hasura.RQL.DDL.Schema.Diff diff --git a/server/src-exec/Migrate.hs b/server/src-exec/Migrate.hs index 12f6c6e4e1d05..34046137fa0a8 100644 --- a/server/src-exec/Migrate.hs +++ b/server/src-exec/Migrate.hs @@ -19,7 +19,7 @@ import qualified Data.Yaml.TH as Y import qualified Database.PG.Query as Q curCatalogVer :: T.Text -curCatalogVer = "16" +curCatalogVer = "17" migrateMetadata :: ( MonadTx m @@ -317,6 +317,13 @@ from15To16 = do migrateMetadataFrom13 = $(unTypeQ (Y.decodeFile "src-rsr/migrate_metadata_from_15_to_16.yaml" :: Q (TExp RQLQuery))) +from16To17 :: (MonadTx m) => m () +from16To17 = liftTx $ do + -- Migrate database + Q.Discard () <- Q.multiQE defaultTxErrorHandler + $(Q.sqlFromFile "src-rsr/migrate_from_16_to_17.sql") + return () + migrateCatalog :: ( MonadTx m , CacheRWM m @@ -347,10 +354,13 @@ migrateCatalog migrationTime = do | preVer == "13" -> from13ToCurrent | preVer == "14" -> from14ToCurrent | preVer == "15" -> from15ToCurrent + | preVer == "16" -> from16ToCurrent | otherwise -> throw400 NotSupported $ "unsupported version : " <> preVer where - from15ToCurrent = from15To16 >> postMigrate + from16ToCurrent = from16To17 >> postMigrate + + from15ToCurrent = from15To16 >> from16ToCurrent from14ToCurrent = from14To15 >> from15ToCurrent diff --git a/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs b/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs index a785f9ca83e52..473b8d6349a09 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs @@ -19,13 +19,11 @@ module Hasura.GraphQL.Resolve.InputValue import Hasura.Prelude import qualified Data.Text as T -import qualified Data.Vector as V import qualified Language.GraphQL.Draft.Syntax as G import Hasura.GraphQL.Resolve.Context import Hasura.GraphQL.Validate.Types import Hasura.RQL.Types -import Hasura.SQL.Types import Hasura.SQL.Value withNotNull @@ -149,39 +147,3 @@ asPGColTextM asPGColTextM val = do pgColValM <- fmap _apvValue <$> asPGColValM val mapM onlyText pgColValM - --- resolveToPGColVal --- :: (MonadError QErr m) --- => AnnInpVal -> m (PGColType, PGColValue) --- resolveToPGColVal annInpVal = --- case _aivValue annInpVal of --- AGPGVal colTy Nothing -> return (colTy, nullVal colTy) --- AGPGVal colTy (Just val) -> return (colTy, val) --- AGEnum _ _ -> throw500 "Enum is not supported for ColVal" --- AGObject _ _ -> throw500 "Object is not supported for ColVal" --- AGArray (G.ListType lt) Nothing -> do --- let colTy = asScalarColType $ getBaseTy lt --- return (colTy, nullVal colTy) --- AGArray (G.ListType lt) (Just vals) -> do --- undefined --- where --- nullVal ty = PGColValue (pgColTyOid ty) PGNull - --- resolveArrayInput --- :: MonadError QErr m --- => G.GType -> [AnnInpVal] -> m PGColValue --- resolveArrayInput gTy inpVals = do --- case gTy of --- G.TypeNamed _ nt -> do --- vals <- mapM asPGVal inpVals --- let elemOid = pgColTyOid $ asScalarColType nt --- valVect = V.fromList vals --- return $ PGColValue undefined $ PGValArray elemOid valVect --- G.TypeList _ (G.ListType lt) -> do --- undefined --- where --- asPGVal v = case _aivValue v of --- AGPGVal _ (Just val) -> return val --- AGPGVal colTy Nothing -> throw500 $ "unexpected null for ty " --- <> T.pack (show colTy) --- _ -> tyMismatch "pgvalue" v diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs index dce56ff086d84..fccdbe01b9b26 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -109,9 +109,6 @@ traverseInsObj rim (gName, annVal) defVal@(AnnInsObj cols objRels arrRels) = colVal = fromMaybe (PGColValue (pgColTyOid colty) PGNull) mColVal return (AnnInsObj ((col, colty, colVal):cols) objRels arrRels) - -- AGArray (G.ListType gty) mVals -> do - -- undefined - _ -> do objM <- asObjectM annVal -- if relational insert input is 'null' then ignore diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Function.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Function.hs index 6adb892aef6fc..a8a34413d6570 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Function.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Function.hs @@ -3,7 +3,6 @@ module Hasura.RQL.DDL.Schema.Function where import Hasura.EncJSON import Hasura.GraphQL.Utils (isValidName, showNames) import Hasura.Prelude -import Hasura.RQL.DDL.Schema.PGType import Hasura.RQL.Types import Hasura.SQL.Types @@ -119,7 +118,7 @@ trackFunctionP1 (TrackFunction qf) = do when (M.member qf $ scFunctions rawSchemaCache) $ throw400 AlreadyTracked $ "function already tracked : " <>> qf -trackFunctionP2Setup :: (QErrM m, CacheRWM m, MonadTx m) +trackFunctionP2Setup :: (QErrM m, CacheRWM m) => PGTyInfoMaps -> QualifiedFunction -> RawFuncInfo -> m () trackFunctionP2Setup tyMaps qf rawfi = do fi <- mkFunctionInfo tyMaps qf rawfi @@ -151,7 +150,6 @@ trackFunctionP2 qf = do "function " <> qf <<> " is overloaded. Overloaded functions are not supported" tyMaps <- liftTx getPGTyInfoMap trackFunctionP2Setup tyMaps qf rawfi --- >>>>>>> master liftTx $ saveFunctionToCatalog qf False return successMsg where @@ -164,6 +162,13 @@ trackFunctionP2 qf = do AND function_name = $2 |] (sn, fn) True +getPGTyInfoMap :: Q.TxE QErr PGTyInfoMaps +getPGTyInfoMap = do + mkPGTyMaps . map (Q.getAltJ . runIdentity) <$> + Q.listQE defaultTxErrorHandler [Q.sql| + SELECT row_to_json(q) FROM hdb_catalog.hdb_type_info q + |] () True + runTrackFunc :: ( QErrM m, CacheRWM m, MonadTx m , UserInfoM m diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs b/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs deleted file mode 100644 index 7bbb70fc89f79..0000000000000 --- a/server/src-lib/Hasura/RQL/DDL/Schema/PGType.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Hasura.RQL.DDL.Schema.PGType where - -import Hasura.Prelude -import Hasura.RQL.Types - -import qualified Database.PG.Query as Q - -getPGTyInfoMap :: Q.TxE QErr PGTyInfoMaps -getPGTyInfoMap = do - pgTyInfo <- Q.catchE defaultTxErrorHandler $ - Q.listQ $(Q.sqlFromFile "src-rsr/pg_type_info.sql") () True - return $ mkPGTyMaps $ map (Q.getAltJ . runIdentity) pgTyInfo diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs index a06a0d3803b08..0a3d91dbe7ac1 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs @@ -14,7 +14,6 @@ import Hasura.RQL.DDL.Relationship import Hasura.RQL.DDL.RemoteSchema import Hasura.RQL.DDL.Schema.Diff import Hasura.RQL.DDL.Schema.Function -import Hasura.RQL.DDL.Schema.PGType import Hasura.RQL.DDL.Schema.Rename import Hasura.RQL.DDL.Utils import Hasura.RQL.Types @@ -365,17 +364,17 @@ buildSchemaCacheG withSetup = do -- clean hdb_views when withSetup $ liftTx $ Q.catchE defaultTxErrorHandler clearHdbViews -- reset the current schemacache - tyMaps <- liftTx getPGTyInfoMap writeSchemaCache emptySchemaCache hMgr <- askHttpManager sqlGenCtx <- askSQLGenCtx -- fetch all catalog metadata CatalogMetadata tables relationships permissions qTemplates - eventTriggers remoteSchemas functions fkeys' allowlistDefs + eventTriggers remoteSchemas functions fkeys' allowlistDefs tyInfos <- liftTx fetchCatalogData let fkeys = HS.fromList fkeys' + tyMaps = mkPGTyMaps tyInfos -- tables tables' <- forM tables $ traverse (resolveColType tyMaps) diff --git a/server/src-lib/Hasura/RQL/Types/Catalog.hs b/server/src-lib/Hasura/RQL/Types/Catalog.hs index b00b09243b89e..c7ce741950f5a 100644 --- a/server/src-lib/Hasura/RQL/Types/Catalog.hs +++ b/server/src-lib/Hasura/RQL/Types/Catalog.hs @@ -93,5 +93,6 @@ data CatalogMetadata , _cmFunctions :: ![CatalogFunction] , _cmForeignKeys :: ![CatalogFKey] , _cmAllowlistCollections :: ![CollectionDef] + , _cmPgTypeInfos :: ![PGTyInfo] } deriving (Show, Eq) $(deriveJSON (aesonDrop 3 snakeCase) ''CatalogMetadata) diff --git a/server/src-lib/Hasura/SQL/Value.hs b/server/src-lib/Hasura/SQL/Value.hs index f4bce31c560b1..bb32c97cc1651 100644 --- a/server/src-lib/Hasura/SQL/Value.hs +++ b/server/src-lib/Hasura/SQL/Value.hs @@ -378,17 +378,6 @@ pgValFromJVal = iresToEither . ifromJSON pattern PGGeogVal :: GeometryWithCRS -> PGBaseColValue pattern PGGeogVal x = PGValKnown (PGValGeo x) - --- txtEncWithGeoVal :: PGColValue -> S.SQLExp --- txtEncWithGeoVal = fromEncPGVal . txtEncodePGValG undefined --- where --- txtEncGeoJson v = bool id applyGeomFromGeoJson (isGeoTy v) $ --- fromEncPGVal $ txtEncodePGVal' v - --- isGeoTy v = case v of --- (PGGeogVal _) -> True --- _ -> False - applyGeomFromGeoJson :: S.SQLExp -> S.SQLExp applyGeomFromGeoJson v = S.SEFnApp "ST_GeomFromGeoJSON" [v] Nothing diff --git a/server/src-rsr/catalog_metadata.sql b/server/src-rsr/catalog_metadata.sql index 524524fa3b897..0e0f71d993eda 100644 --- a/server/src-rsr/catalog_metadata.sql +++ b/server/src-rsr/catalog_metadata.sql @@ -8,7 +8,8 @@ select 'remote_schemas', remote_schemas.items, 'functions', functions.items, 'foreign_keys', foreign_keys.items, - 'allowlist_collections', allowlist.item + 'allowlist_collections', allowlist.item, + 'pg_type_infos', types.items ) from ( @@ -197,4 +198,7 @@ from left outer join hdb_catalog.hdb_query_collection hqc on (hqc.collection_name = ha.collection_name) - ) as allowlist + ) as allowlist, + ( + select json_agg(row_to_json(q)) as items from hdb_catalog.hdb_type_info q + ) as types diff --git a/server/src-rsr/function_info.sql b/server/src-rsr/function_info.sql deleted file mode 100644 index d406608569f7e..0000000000000 --- a/server/src-rsr/function_info.sql +++ /dev/null @@ -1,46 +0,0 @@ -SELECT - row_to_json ( - ( - SELECT - e - FROM - ( - SELECT - hf.has_variadic, - hf.function_type, - hf.return_type_schema, - hf.return_type_name, - hf.return_type_type, - hf.returns_set, - hf.input_arg_names, - ( - select json_agg(row_to_json(x)) from - ( select - fo.oid as oid, - case - when arr_elem_ty.oid is NOT NULL then 1 - else 0 - end as dimension - from - (select unnest( COALESCE(pp.proallargtypes, pp.proargtypes) :: int[]) as oid ) fo - left outer join pg_type arr_elem_ty on arr_elem_ty.typarray = fo.oid - ) x - ) as input_arg_types, - exists( - SELECT - 1 - FROM - information_schema.tables - WHERE - table_schema = hf.return_type_schema - AND table_name = hf.return_type_name - ) AS returns_table - ) AS e - ) - ) AS "raw_function_info" - FROM - hdb_catalog.hdb_function_agg hf left outer join pg_proc pp - on hf.function_name = pp.proname and hf.function_schema = pp.pronamespace::regnamespace::text - WHERE - hf.function_schema = $1 - AND hf.function_name = $2 diff --git a/server/src-rsr/initialise.sql b/server/src-rsr/initialise.sql index 5f2c7201afb0d..20694f934c332 100644 --- a/server/src-rsr/initialise.sql +++ b/server/src-rsr/initialise.sql @@ -467,8 +467,6 @@ from json_build_object( 'oid', ty.oid :: int , - -- 'sqlName', - -- pg_catalog.format_type(td.atttypid, td.atttypmod), 'dimension', td.attndims ), @@ -626,3 +624,90 @@ CREATE TABLE hdb_catalog.hdb_allowlist collection_name TEXT UNIQUE REFERENCES hdb_catalog.hdb_query_collection(collection_name) ); + +CREATE VIEW hdb_catalog.hdb_type_info AS +( +select + t.oid :: integer as oid, + json_build_object( + 'name', + t.typname, + 'schema', + ns.nspname + ) as name, + pg_catalog.format_type(t.oid, NULL) as sql_name, + case + when arr_elem.oid is not null then json_build_object( + 'type', + 'array', + 'elem_oid', + arr_elem.oid :: integer + ) + when t.typtype = 'b' then json_build_object('type', 'base') + when t.typtype = 'e' then json_build_object( + 'type', + 'enum', + 'possible_values', + ( + select + array_agg( + enumlabel + order by + enumsortorder + ) + from + pg_enum + where + enumtypid = t.oid + ) + ) + when t.typtype = 'c' then json_build_object( + 'type', + 'composite', + 'fields', + ( + select + json_agg( + ( + select + json_build_object( + attname, + ( + select + row_to_json(x) + from + ( + select + atttypid :: integer as oid, + attndims as dimension + ) x + ) + ) + ) + ) + from + pg_attribute + where + attrelid = t.typrelid + ) + ) + when t.typtype = 'd' then json_build_object( + 'type', + 'domain', + 'base_type', + json_build_object( + 'oid', + t.typbasetype :: integer, + 'dimension', + t.typndims + ) + ) + when t.typtype = 'p' then json_build_object('type', 'pseudo') + when t.typtype = 'r' then json_build_object('type', 'range') + else null + end as detail +from + pg_type t + left outer join pg_namespace ns on t.typnamespace = ns.oid + left outer join pg_type arr_elem on t.oid = arr_elem.typarray +); diff --git a/server/src-rsr/migrate_from_16_to_17.sql b/server/src-rsr/migrate_from_16_to_17.sql new file mode 100644 index 0000000000000..e8a963b789f60 --- /dev/null +++ b/server/src-rsr/migrate_from_16_to_17.sql @@ -0,0 +1,267 @@ +CREATE OR REPLACE VIEW hdb_catalog.hdb_function_agg AS +( +SELECT + p.proname::text AS function_name, + pn.nspname::text AS function_schema, + + CASE + WHEN (p.provariadic = (0) :: oid) THEN false + ELSE true + END AS has_variadic, + + CASE + WHEN ( + (p.provolatile) :: text = ('i' :: character(1)) :: text + ) THEN 'IMMUTABLE' :: text + WHEN ( + (p.provolatile) :: text = ('s' :: character(1)) :: text + ) THEN 'STABLE' :: text + WHEN ( + (p.provolatile) :: text = ('v' :: character(1)) :: text + ) THEN 'VOLATILE' :: text + ELSE NULL :: text + END AS function_type, + + pg_get_functiondef(p.oid) AS function_definition, + + rtn.nspname::text AS return_type_schema, + rt.typname::text AS return_type_name, + + CASE + WHEN ((rt.typtype) :: text = ('b' :: character(1)) :: text) THEN 'BASE' :: text + WHEN ((rt.typtype) :: text = ('c' :: character(1)) :: text) THEN 'COMPOSITE' :: text + WHEN ((rt.typtype) :: text = ('d' :: character(1)) :: text) THEN 'DOMAIN' :: text + WHEN ((rt.typtype) :: text = ('e' :: character(1)) :: text) THEN 'ENUM' :: text + WHEN ((rt.typtype) :: text = ('r' :: character(1)) :: text) THEN 'RANGE' :: text + WHEN ((rt.typtype) :: text = ('p' :: character(1)) :: text) THEN 'PSUEDO' :: text + ELSE NULL :: text + END AS return_type_type, + p.proretset AS returns_set, + ( SELECT + COALESCE(json_agg(q.type_info), '[]') + FROM + ( + SELECT + json_build_object( + 'oid', pat.oid::int, + 'dimension', + case + when pt.oid IS NOT NULL then 1 + else 0 + end, + 'name', format_type(pat.oid, null) + ) AS type_info, + pat.ordinality + FROM + UNNEST( + COALESCE(p.proallargtypes, (p.proargtypes) :: oid []) + ) WITH ORDINALITY pat(oid, ordinality) + LEFT OUTER JOIN + pg_type pt ON (pt.typarray = pat.oid) + ORDER BY pat.ordinality ASC + ) q + ) AS input_arg_types, + to_json(COALESCE(p.proargnames, ARRAY [] :: text [])) AS input_arg_names +FROM + pg_proc p + JOIN pg_namespace pn ON (pn.oid = p.pronamespace) + JOIN pg_type rt ON (rt.oid = p.prorettype) + JOIN pg_namespace rtn ON (rtn.oid = rt.typnamespace) +WHERE + pn.nspname :: text NOT LIKE 'pg_%' + AND pn.nspname :: text NOT IN ('information_schema', 'hdb_catalog', 'hdb_views') + AND (NOT EXISTS ( + SELECT + 1 + FROM + pg_aggregate + WHERE + ((pg_aggregate.aggfnoid) :: oid = p.oid) + ) + ) +); + +CREATE OR REPLACE VIEW hdb_catalog.hdb_table_info_agg AS ( +select + tables.table_name as table_name, + tables.table_schema as table_schema, + coalesce(columns.columns, '[]') as columns, + coalesce(pk.columns, '[]') as primary_key_columns, + coalesce(constraints.constraints, '[]') as constraints, + coalesce(views.view_info, 'null') as view_info +from + information_schema.tables as tables + left outer join ( + select + c.table_name, + c.table_schema, + json_agg( + json_build_object( + 'name', + column_name, + 'type', + json_build_object( + 'oid', + ty.oid :: int , + 'dimension', + td.attndims + ), + 'is_nullable', + is_nullable :: boolean + ) + ) as columns + from + information_schema.columns c + left outer join ( + select pc.relnamespace, + pc.relname, + pa.attname, + pa.attndims, + pa.atttypid, + pa.atttypmod + from pg_attribute pa + left join pg_class pc + on pa.attrelid = pc.oid + ) td on + ( c.table_schema::regnamespace::oid = td.relnamespace + AND c.table_name = td.relname + AND c.column_name = td.attname + ) + left outer join pg_type ty + on td.atttypid = ty.oid + group by + c.table_schema, + c.table_name + ) columns on ( + tables.table_schema = columns.table_schema + AND tables.table_name = columns.table_name + ) + left outer join ( + select * from hdb_catalog.hdb_primary_key + ) pk on ( + tables.table_schema = pk.table_schema + AND tables.table_name = pk.table_name + ) + left outer join ( + select + c.table_schema, + c.table_name, + json_agg(constraint_name) as constraints + from + information_schema.table_constraints c + where + c.constraint_type = 'UNIQUE' + or c.constraint_type = 'PRIMARY KEY' + group by + c.table_schema, + c.table_name + ) constraints on ( + tables.table_schema = constraints.table_schema + AND tables.table_name = constraints.table_name + ) + left outer join ( + select + table_schema, + table_name, + json_build_object( + 'is_updatable', + (is_updatable::boolean OR is_trigger_updatable::boolean), + 'is_deletable', + (is_updatable::boolean OR is_trigger_deletable::boolean), + 'is_insertable', + (is_insertable_into::boolean OR is_trigger_insertable_into::boolean) + ) as view_info + from + information_schema.views v + ) views on ( + tables.table_schema = views.table_schema + AND tables.table_name = views.table_name + ) +); + +CREATE OR REPLACE VIEW hdb_catalog.hdb_type_info AS +( +select + t.oid :: integer as oid, + json_build_object( + 'name', + t.typname, + 'schema', + ns.nspname + ) as name, + pg_catalog.format_type(t.oid, NULL) as sql_name, + case + when arr_elem.oid is not null then json_build_object( + 'type', + 'array', + 'elem_oid', + arr_elem.oid :: integer + ) + when t.typtype = 'b' then json_build_object('type', 'base') + when t.typtype = 'e' then json_build_object( + 'type', + 'enum', + 'possible_values', + ( + select + array_agg( + enumlabel + order by + enumsortorder + ) + from + pg_enum + where + enumtypid = t.oid + ) + ) + when t.typtype = 'c' then json_build_object( + 'type', + 'composite', + 'fields', + ( + select + json_agg( + ( + select + json_build_object( + attname, + ( + select + row_to_json(x) + from + ( + select + atttypid :: integer as oid, + attndims as dimension + ) x + ) + ) + ) + ) + from + pg_attribute + where + attrelid = t.typrelid + ) + ) + when t.typtype = 'd' then json_build_object( + 'type', + 'domain', + 'base_type', + json_build_object( + 'oid', + t.typbasetype :: integer, + 'dimension', + t.typndims + ) + ) + when t.typtype = 'p' then json_build_object('type', 'pseudo') + when t.typtype = 'r' then json_build_object('type', 'range') + else null + end as detail +from + pg_type t + left outer join pg_namespace ns on t.typnamespace = ns.oid + left outer join pg_type arr_elem on t.oid = arr_elem.typarray +); diff --git a/server/src-rsr/pg_type_info.sql b/server/src-rsr/pg_type_info.sql deleted file mode 100644 index fa2181bb22d88..0000000000000 --- a/server/src-rsr/pg_type_info.sql +++ /dev/null @@ -1,70 +0,0 @@ -select row_to_json(types) as types -from ( - select - t.oid :: integer as oid, - json_build_object( - 'name', - t.typname, - 'schema', - ns.nspname - ) as name, - pg_catalog.format_type(t.oid,NULL) as sql_name, - case - when arr_elem.oid is not null then - json_build_object( - 'type', - 'array', - 'elem_oid', - arr_elem.oid :: integer - ) - when t.typtype = 'b' then - json_build_object( - 'type', - 'base' - ) - when t.typtype = 'e' then - json_build_object( - 'type', - 'enum', - 'possible_values', - ( select array_agg(enumlabel order by enumsortorder) from pg_enum where enumtypid=t.oid ) - ) - - when t.typtype = 'c' then - json_build_object( - 'type', - 'composite', - 'fields', - ( select json_agg( ( select json_build_object( attname, ( select row_to_json(x) from (select atttypid :: integer as oid, attndims as dimension ) x ) ) ) ) from pg_attribute where attrelid = t.typrelid ) - ) - - when t.typtype = 'd' then - json_build_object( - 'type', - 'domain', - 'base_type', - json_build_object( - 'oid', - t.typbasetype:: integer, - 'dimension', - t.typndims - ) - ) - when t.typtype = 'p' then - json_build_object( - 'type', - 'pseudo' - ) - when t.typtype = 'r' then - json_build_object( - 'type', - 'range' - ) - else null - end as detail - from pg_type t - left outer join pg_namespace ns - on t.typnamespace = ns.oid - left outer join pg_type arr_elem - on t.oid = arr_elem.typarray - ) types diff --git a/server/src-rsr/table_info.sql b/server/src-rsr/table_info.sql deleted file mode 100644 index e3761aac2e140..0000000000000 --- a/server/src-rsr/table_info.sql +++ /dev/null @@ -1,111 +0,0 @@ -select - coalesce(columns.columns, '[]') as columns, - coalesce(constraints.constraints, '[]') as constraints, - coalesce(views.view_info, 'null') as view_info -from - information_schema.tables as tables - left outer join ( - select - c.table_schema, - c.table_name, - json_agg( - json_build_object( - 'name', - column_name, - 'type', - json_build_object( - 'name', - json_build_object( - 'name', - ty.typname, - 'schema', - ty.typnamespace::regnamespace::text - ), - 'oid', - ty.oid :: int , - 'sqlName', - pg_catalog.format_type(td.atttypid, td.atttypmod), - 'dimension', - td.attndims - ), - 'is_nullable', - is_nullable :: boolean - ) - ) as columns - from - information_schema.columns c - left outer join ( - select pc.relnamespace, - pc.relname, - pa.attname, - pa.attndims, - pa.atttypid, - pa.atttypmod - from pg_attribute pa - left join pg_class pc - on pa.attrelid = pc.oid - ) td on - ( c.table_schema::regnamespace::oid = td.relnamespace - AND c.table_name = td.relname - AND c.column_name = td.attname - ) - left outer join pg_type ty - on td.atttypid = ty.oid - group by - c.table_schema, - c.table_name - ) columns on ( - tables.table_schema = columns.table_schema - AND tables.table_name = columns.table_name - ) - left outer join ( - select - cm.table_schema, - cm.table_name, - json_agg( - json_build_object( - 'type', cm.constraint_type, - 'name', cm.constraint_name, - 'cols', cm.columns - ) - ) as constraints - from - ( - select table_name, table_schema, - constraint_name, columns, - 'PRIMARY KEY' as constraint_type - from hdb_catalog.hdb_primary_key - union all - select table_name, table_schema, - constraint_name, columns, - 'UNIQUE' as constraint_type - from hdb_catalog.hdb_unique_constraint - ) cm - group by - cm.table_schema, - cm.table_name - ) constraints on ( - tables.table_schema = constraints.table_schema - AND tables.table_name = constraints.table_name - ) - left outer join ( - select - table_schema, - table_name, - json_build_object( - 'is_updatable', - (is_updatable::boolean OR is_trigger_updatable::boolean), - 'is_deletable', - (is_updatable::boolean OR is_trigger_deletable::boolean), - 'is_insertable', - (is_insertable_into::boolean OR is_trigger_insertable_into::boolean) - ) as view_info - from - information_schema.views v - ) views on ( - tables.table_schema = views.table_schema - AND tables.table_name = views.table_name - ) -where - tables.table_schema = $1 AND - tables.table_name = $2 From 8dfadf4127b890c4805dc9d551e8dc76d6683c5d Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Tue, 21 May 2019 17:00:01 +0530 Subject: [PATCH 11/13] refactor types/functions & remove commented code --- server/src-lib/Hasura/GraphQL/Context.hs | 64 +++---- .../src-lib/Hasura/GraphQL/Execute/Query.hs | 2 +- server/src-lib/Hasura/GraphQL/Explain.hs | 2 +- .../Hasura/GraphQL/Resolve/Introspect.hs | 2 +- server/src-lib/Hasura/GraphQL/Schema.hs | 19 +- .../src-lib/Hasura/GraphQL/Validate/Types.hs | 66 +++---- server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs | 163 ++++++++++-------- server/src-lib/Hasura/RQL/DML/Internal.hs | 39 ++--- server/src-lib/Hasura/RQL/GBoolExp.hs | 34 ++-- server/src-lib/Hasura/RQL/Types/Common.hs | 14 +- .../src-lib/Hasura/RQL/Types/SchemaCache.hs | 8 - server/src-lib/Hasura/SQL/DML.hs | 3 - server/src-lib/Hasura/SQL/Rewrite.hs | 2 +- server/src-lib/Hasura/SQL/Types.hs | 89 ++++++---- server/src-lib/Hasura/SQL/Value.hs | 86 ++++----- 15 files changed, 307 insertions(+), 286 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Context.hs b/server/src-lib/Hasura/GraphQL/Context.hs index 02d0102107827..e4c324cf5bb52 100644 --- a/server/src-lib/Hasura/GraphQL/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Context.hs @@ -180,17 +180,18 @@ mkCompExpName colTy = G.Name $ colTyTxt colTy <> "_comparison_exp" where colTyTxt t = case pgColTyDetails t of - PGTyBase b - -> T.pack (show b) - PGTyDomain b - -> colTyTxt b - _ - -> case getArrayBaseTy t of - Nothing -> qualTyToScalar (pgColTyName t) - -- Array type - Just b -> case pgColTyDetails b of - PGTyBase bb -> T.pack $ show bb <> "_" <> show (getPGTyArrDim t) <> "d" - _ -> qualTyToScalar (pgColTyName b) + PGTyBase b -> T.pack (show b) + PGTyDomain b -> colTyTxt b + _ -> asArray t + + asArray t = case getArrayBaseTy t of + Nothing -> qualTyToScalar $ pgColTyName t + -- Array type + Just b -> case pgColTyDetails b of + PGTyBase bb -> T.pack $ show bb <> "_" + <> show (getPGTyArrDim t) <> "d" + _ -> qualTyToScalar (pgColTyName b) + mkCompExpTy :: PGColType -> G.NamedType mkCompExpTy = @@ -219,22 +220,23 @@ stDWithinGeographyInpTy = G.NamedType "st_d_within_geography_input" --- | make compare expression input type mkCompExpInp :: PGColType -> InpObjTyInfo -mkCompExpInp colTy@(PGColType _ _ _ colDtls) = +mkCompExpInp colTy = InpObjTyInfo (Just tyDesc) (mkCompExpTy colTy) (fromInpValL $ concat [ map (mkPGTy colTy) typedOps , map (mk (Just $ arrOfCol colTy) $ G.toLT colGQLTy) listOps - , bool [] (map (mkPGTy $ baseTy PGText) stringOps) isStringTy + , bool [] (map (mkPGTy textColTy) stringOps) isStringTy , bool [] (map (mkPGTy colTy) arrOps) isArrTy , bool [] (map jsonbOpToInpVal jsonbOps) isJsonbTy , bool [] (stDWithinGeoOpInpVal stDWithinGeometryInpTy : map geoOpToInpVal (geoOps ++ geomOps)) isGeometryType , bool [] (stDWithinGeoOpInpVal stDWithinGeographyInpTy : map geoOpToInpVal geoOps) isGeographyType - , [ InpValInfo Nothing "_is_null" Nothing (Just $ PTCol $ baseTy PGBoolean) $ - G.TypeNamed (G.Nullability True) $ G.NamedType "Boolean" + , [ InpValInfo Nothing "_is_null" Nothing (Just $ PTCol boolColTy) $ + mkPGColGTy boolColTy ] ]) HasuraType where + colDtls = pgColTyDetails colTy arrOfCol = PTArr . PTCol tyDesc = mconcat [ "expression to compare columns of type " @@ -274,23 +276,23 @@ mkCompExpInp colTy@(PGColType _ _ _ colDtls) = jsonbOpToInpVal (op, pgTy, desc) = InpValInfo (Just desc) op Nothing (Just pgTy) $ pgTyAnnToGTy pgTy jsonbOps = [ ( "_contains" - , PTCol $ baseTy PGJSONB + , PTCol jsonbColTy , "does the column contain the given json value at the top level" ) , ( "_contained_in" - , PTCol $ baseTy PGJSONB + , PTCol jsonbColTy , "is the column contained in the given json value" ) , ( "_has_key" - , PTCol $ baseTy PGText + , PTCol textColTy , "does the string exist as a top-level key in the column" ) , ( "_has_keys_any" - , PTArr $ PTCol $ baseTy PGText + , PTArr $ PTCol textColTy , "do any of these strings exist as top-level keys in the column" ) , ( "_has_keys_all" - , PTArr $ PTCol $ baseTy PGText + , PTArr $ PTCol textColTy , "do all of these strings exist as top-level keys in the column" ) ] @@ -311,7 +313,8 @@ mkCompExpInp colTy@(PGColType _ _ _ colDtls) = _ -> False geoOpToInpVal (op, desc) = - InpValInfo (Just desc) op Nothing (Just $ PTCol colTy) $ G.toGT $ mkScalarTy colTy + InpValInfo (Just desc) op Nothing (Just $ PTCol colTy) $ + G.toGT $ mkScalarTy colTy colTyDesc = G.Description $ T.pack $ show colTy @@ -423,29 +426,28 @@ mkGCtx tyAgg (RootFlds flds) insCtxMap = G.toGT $ G.NamedType "__Type" where typeFldArgs = mapFromL _iviName [ - mkPGTyInpValNT (Just "name of the type") "name" $ baseTy PGText - -- $ G.toGT $ G.toNT $ G.NamedType "String" + mkPGTyInpValNT (Just "name of the type") "name" textColTy ] -- _st_d_within has to stay with geometry type stDWithinGeometryInpM = - bool Nothing (Just $ stDWithinGeomInp) (PGTyBase PGGeometry `elem` colTyDets) + bool Nothing (Just stDWithinGeomInp) (PGTyBase PGGeometry `elem` colTyDets) -- _st_d_within_geography is created for geography type stDWithinGeographyInpM = - bool Nothing (Just $ stDWithinGeogInp) (PGTyBase PGGeography `elem` colTyDets) + bool Nothing (Just stDWithinGeogInp) (PGTyBase PGGeography `elem` colTyDets) stDWithinGeomInp = mkHsraInpTyInfo Nothing stDWithinGeometryInpTy $ fromInpValL - [ mkPGTyInpValNT Nothing "from" $ baseTy PGGeometry - , mkPGTyInpValNT Nothing "distance" $ baseTy PGFloat + [ mkPGTyInpValNT Nothing "from" geometryColTy + , mkPGTyInpValNT Nothing "distance" floatColTy ] stDWithinGeogInp = mkHsraInpTyInfo Nothing stDWithinGeographyInpTy $ fromInpValL - [ mkPGTyInpValNT Nothing "from" $ baseTy PGGeography - , mkPGTyInpValNT Nothing "distance" $ baseTy PGFloat + [ mkPGTyInpValNT Nothing "from" geographyColTy + , mkPGTyInpValNT Nothing "distance" floatColTy , InpValInfo Nothing "use_spheroid" - (Just $ G.VCBoolean True) (Just $ PTCol $ baseTy PGBoolean) $ - G.toGT $ mkPGColGTy $ baseTy PGBoolean + (Just $ G.VCBoolean True) (Just $ PTCol boolColTy) $ + G.toGT $ mkPGColGTy boolColTy ] emptyGCtx :: GCtx diff --git a/server/src-lib/Hasura/GraphQL/Execute/Query.hs b/server/src-lib/Hasura/GraphQL/Execute/Query.hs index ae4a059203488..0da820409d6c0 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/Query.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/Query.hs @@ -188,7 +188,7 @@ prepareWithPlan = \case addPrepArg argNum $ binEncoder colVal return $ toPrepParam argNum colTy R.UVSessVar colTy sessVar -> - return $ S.annotateExp colTy $ withGeom colTy $ + return $ S.annotateExp colTy $ withGeoVal colTy $ S.SEOpApp (S.SQLOp "->>") [S.SEPrep 1, S.SELit $ T.toLower sessVar] R.UVSQL sqlExp -> return sqlExp diff --git a/server/src-lib/Hasura/GraphQL/Explain.hs b/server/src-lib/Hasura/GraphQL/Explain.hs index db453e4bc3ee3..3b68c54f57a0e 100644 --- a/server/src-lib/Hasura/GraphQL/Explain.hs +++ b/server/src-lib/Hasura/GraphQL/Explain.hs @@ -62,7 +62,7 @@ resolveVal userInfo = \case txtConverter annPGVal RS.UVSessVar colTy sessVar -> do sessVarVal <- getSessVarVal userInfo sessVar - return $ S.annotateExp colTy $ withGeom colTy $ + return $ S.annotateExp colTy $ withGeoVal colTy $ S.SELit sessVarVal RS.UVSQL sqlExp -> return sqlExp diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs b/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs index fef14b134e9ac..6b121d1762c1f 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs @@ -99,7 +99,7 @@ getImplTypes :: (MonadReader t m, Has TypeMap t) => AsObjType -> m [ObjTyInfo] getImplTypes aot = do tyInfo :: TypeMap <- asks getter return $ sortOn _otiName $ - Map.elems $ getPossibleObjTypes' tyInfo aot + Map.elems $ getPossibleObjTypes tyInfo aot -- 4.5.2.3 unionR diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index ae9cac0e74a7f..f278a1c478e59 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -178,7 +178,7 @@ mkPGColParams = \case where pathDesc = "JSON select path" jsonParams = Map.fromList - [ (G.Name "path", mkPGTyInpVal (Just pathDesc) "path" $ baseTy PGText) + [ (G.Name "path", mkPGTyInpVal (Just pathDesc) "path" textColTy) ] mkPGColFld :: PGColInfo -> ObjFldInfo @@ -198,8 +198,8 @@ mkPGColFld (PGColInfoG colName colTy isNullable) = mkSelArgs :: QualifiedTable -> [InpValInfo] mkSelArgs tn = [ InpValInfo (Just whereDesc) "where" Nothing Nothing $ G.toGT $ mkBoolExpTy tn - , mkPGTyInpVal (Just limitDesc) "limit" $ baseTy PGInteger - , mkPGTyInpVal (Just offsetDesc) "offset" $ baseTy PGInteger + , mkPGTyInpVal (Just limitDesc) "limit" integerColTy + , mkPGTyInpVal (Just offsetDesc) "offset" integerColTy , InpValInfo (Just orderByDesc) "order_by" Nothing Nothing $ G.toGT $ G.toLT $ G.toNT $ mkOrdByTy tn , InpValInfo (Just distinctDesc) "distinct_on" Nothing Nothing $ G.toGT $ G.toLT $ @@ -315,13 +315,13 @@ mkTableAggFldsObj tn numCols compCols = desc = G.Description $ "aggregate fields of " <>> tn - countFld = mkHsraPGTyObjFld Nothing "count" countParams $ baseTy PGInteger + countFld = mkHsraPGTyObjFld Nothing "count" countParams integerColTy countParams = fromInpValL [countColInpVal, distinctInpVal] countColInpVal = InpValInfo Nothing "columns" Nothing Nothing $ G.toGT $ G.toLT $ G.toNT $ mkSelColumnInpTy tn - distinctInpVal = mkPGTyInpVal Nothing "distinct" $ baseTy PGBoolean + distinctInpVal = mkPGTyInpVal Nothing "distinct" boolColTy numFlds = bool (map mkColOpFld numAggOps) [] $ null numCols compFlds = bool (map mkColOpFld compAggOps) [] $ null compCols @@ -503,7 +503,7 @@ mkMutRespObj tn sel = objDesc = G.Description $ "response of any mutation on the table " <>> tn affectedRowsFld = - mkHsraPGTyObjFld (Just desc) "affected_rows" Map.empty $ baseTy PGInteger + mkHsraPGTyObjFld (Just desc) "affected_rows" Map.empty integerColTy where desc = "number of affected rows by the mutation" returningFld = @@ -784,12 +784,13 @@ mkUpdJSONOpInp tn cols = bool inpObjs [] $ null jsonbCols deleteKeyInpObj = mkHsraInpTyInfo (Just deleteKeyDesc) (mkJSONOpTy tn deleteKeyOp) $ fromInpValL $ map deleteKeyInpVal jsonbColNames - deleteKeyInpVal c = mkPGTyInpVal Nothing (G.Name $ getPGColTxt c) $ baseTy PGText + deleteKeyInpVal c = mkPGTyInpVal Nothing (G.Name $ getPGColTxt c) textColTy deleteElemInpObj = mkHsraInpTyInfo (Just deleteElemDesc) (mkJSONOpTy tn deleteElemOp) $ fromInpValL $ map deleteElemInpVal jsonbColNames - deleteElemInpVal c = mkPGTyInpVal Nothing (G.Name $ getPGColTxt c) $ baseTy PGInteger + deleteElemInpVal c = + mkPGTyInpVal Nothing (G.Name $ getPGColTxt c) integerColTy deleteAtPathInpObj = mkHsraInpTyInfo (Just deleteAtPathDesc) (mkJSONOpTy tn deleteAtPathOp) $ @@ -1424,7 +1425,7 @@ mkGCtxRole' tn insPermM selPermM updColsM getNumCols = onlyNumCols . lefts getCompCols = onlyComparableCols . lefts - onlyFloat = const $ baseTy PGFloat + onlyFloat = const floatColTy mkTypeMaker "sum" = id mkTypeMaker _ = onlyFloat diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index c925bc35b85de..c81215f08fc44 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} module Hasura.GraphQL.Validate.Types ( InpValInfo(..) , ParamMap @@ -28,7 +27,7 @@ module Hasura.GraphQL.Validate.Types , TypeInfo(..) , isObjTy , isIFaceTy - , getPossibleObjTypes' + , getPossibleObjTypes , getObjTyM , getInpObjTyM , getUnionTyM @@ -131,16 +130,6 @@ pgTyAnnToGTy :: PGColTyAnn -> G.GType pgTyAnnToGTy (PTCol colTy) = mkPGColGTy colTy pgTyAnnToGTy (PTArr p) = G.toGT $ G.toLT $ G.toNT $ pgTyAnnToGTy p --- asScalarColType :: G.NamedType -> PGColType --- asScalarColType nt = --- Map.lookupDefault defTy (nt, 0) defaultPGColTyMap --- where --- defTy = baseTy $ txtToPgBaseColTy $ G.unName $ G.unNamedType nt - --- gTyToPgTyAnn :: G.GType -> PGColTyAnn --- gTyToPgTyAnn (G.TypeNamed _ nt) = PTCol $ asScalarColType nt --- gTyToPgTyAnn (G.TypeList _ (G.ListType gTy)) = PTArr $ gTyToPgTyAnn gTy - data InpValInfo = InpValInfo { _iviDesc :: !(Maybe G.Description) @@ -298,7 +287,8 @@ instance Semigroup UnionTyInfo where } fromUnionTyDef :: G.UnionTypeDefinition -> UnionTyInfo -fromUnionTyDef (G.UnionTypeDefinition descM n _ mt) = UnionTyInfo descM (G.NamedType n) $ Set.fromList mt +fromUnionTyDef (G.UnionTypeDefinition descM n _ mt) = + UnionTyInfo descM (G.NamedType n) $ Set.fromList mt type InpObjFldMap = Map.HashMap G.Name InpValInfo @@ -356,15 +346,17 @@ data AsObjType | AOTIFace IFaceTyInfo | AOTUnion UnionTyInfo -getPossibleObjTypes' :: TypeMap -> AsObjType -> Map.HashMap G.NamedType ObjTyInfo -getPossibleObjTypes' _ (AOTObj obj) = toObjMap [obj] -getPossibleObjTypes' tyMap (AOTIFace i) = toObjMap $ mapMaybe previewImplTypeM $ Map.elems tyMap +getPossibleObjTypes :: TypeMap -> AsObjType -> Map.HashMap G.NamedType ObjTyInfo +getPossibleObjTypes tyMap = \case + AOTObj obj -> toObjMap [obj] + AOTIFace i -> toObjMap $ mapMaybe (previewImplTypeM i) $ Map.elems tyMap + AOTUnion u -> toObjMap $ mapMaybe (extrObjTyInfoM tyMap) $ + Set.toList $ _utiMemberTypes u where - previewImplTypeM = \case + previewImplTypeM i = \case TIObj objTyInfo -> bool Nothing (Just objTyInfo) $ _ifName i `elem` _otiImplIFaces objTyInfo _ -> Nothing -getPossibleObjTypes' tyMap (AOTUnion u) = toObjMap $ mapMaybe (extrObjTyInfoM tyMap) $ Set.toList $ _utiMemberTypes u toObjMap :: [ObjTyInfo] -> Map.HashMap G.NamedType ObjTyInfo toObjMap objs = foldr (\o -> Map.insert (_otiName o) o) Map.empty objs @@ -426,16 +418,20 @@ showSPTxt :: SchemaPath -> Text showSPTxt p = showSPTxt' p <> showSP p validateIFace :: MonadError Text f => IFaceTyInfo -> f () -validateIFace (IFaceTyInfo _ n flds) = do - when (isFldListEmpty flds) $ throwError $ "List of fields cannot be empty for interface " <> showNamedTy n +validateIFace (IFaceTyInfo _ n flds) = + when (isFldListEmpty flds) $ throwError $ + "List of fields cannot be empty for interface " <> showNamedTy n validateObj :: TypeMap -> ObjTyInfo -> Either Text () validateObj tyMap objTyInfo@(ObjTyInfo _ n _ flds) = do - when (isFldListEmpty flds) $ throwError $ "List of fields cannot be empty for " <> objTxt - mapM_ (extrIFaceTyInfo' >=> validateIFaceImpl objTyInfo) $ _otiImplIFaces objTyInfo + when (isFldListEmpty flds) $ + throwError $ "List of fields cannot be empty for " <> objTxt + mapM_ (extrIFaceTyInfo' >=> validateIFaceImpl objTyInfo) $ + _otiImplIFaces objTyInfo where extrIFaceTyInfo' t = withObjTxt $ extrIFaceTyInfo tyMap t - withObjTxt x = x `catchError` \e -> throwError $ e <> " implemented by " <> objTxt + withObjTxt x = + x `catchError` \e -> throwError $ e <> " implemented by " <> objTxt objTxt = "Object type " <> showNamedTy n validateIFaceImpl = implmntsIFace tyMap @@ -449,8 +445,13 @@ validateUnion tyMap (UnionTyInfo _ un mt) = do where valIsObjTy mn = case Map.lookup mn tyMap of Just (TIObj t) -> return t - Nothing -> throwError $ "Could not find type " <> showNamedTy mn <> ", which is defined as a member type of Union " <> showNamedTy un - _ -> throwError $ "Union type " <> showNamedTy un <> " can only include object types. It cannot include " <> showNamedTy mn + Nothing -> throwError $ "Could not find type " + <> showNamedTy mn + <> ", which is defined as a member type of Union " + <> showNamedTy un + _ -> throwError $ "Union type " <> showNamedTy un + <> " can only include object types. It cannot include " + <> showNamedTy mn implmntsIFace :: TypeMap -> ObjTyInfo -> IFaceTyInfo -> Either Text () implmntsIFace tyMap objTyInfo iFaceTyInfo = do @@ -505,7 +506,9 @@ extrTyInfo tyMap tn = maybe return $ Map.lookup tn tyMap -extrIFaceTyInfo :: MonadError Text m => Map.HashMap G.NamedType TypeInfo -> G.NamedType -> m IFaceTyInfo +extrIFaceTyInfo + :: MonadError Text m + => Map.HashMap G.NamedType TypeInfo -> G.NamedType -> m IFaceTyInfo extrIFaceTyInfo tyMap tn = case Map.lookup tn tyMap of Just (TIIFace i) -> return i _ -> throwError $ "Could not find interface " <> showNamedTy tn @@ -515,7 +518,8 @@ extrObjTyInfoM tyMap tn = case Map.lookup tn tyMap of Just (TIObj o) -> return o _ -> Nothing -validateIsSubType :: Map.HashMap G.NamedType TypeInfo -> G.GType -> G.GType -> Either Text () +validateIsSubType + :: Map.HashMap G.NamedType TypeInfo -> G.GType -> G.GType -> Either Text () validateIsSubType tyMap subFldTy supFldTy = do checkNullMismatch subFldTy supFldTy case (subFldTy,supFldTy) of @@ -541,7 +545,10 @@ isSubTypeBase subTyInfo supTyInfo = case (subTyInfo,supTyInfo) of _ -> unless (subTyInfo == supTyInfo) notSubTyErr where showTy = showNamedTy . getNamedTy - notSubTyErr = throwError $ "Type " <> showTy subTyInfo <> " is not a sub type of " <> showTy supTyInfo + notSubTyErr = throwError $ "Type " + <> showTy subTyInfo + <> " is not a sub type of " + <> showTy supTyInfo pgColTyToScalar :: PGColType -> Text pgColTyToScalar t = case (pgColTyName udt, pgColTyDetails udt) of @@ -668,8 +675,7 @@ defaultDirectives = [mkDirective "skip", mkDirective "include"] where mkDirective n = DirectiveInfo Nothing n args dirLocs - args = Map.singleton "if" $ mkPGTyInpValNT Nothing "if" $ - baseTy PGBoolean + args = Map.singleton "if" $ mkPGTyInpValNT Nothing "if" boolColTy dirLocs = map G.DLExecutable [G.EDLFIELD, G.EDLFRAGMENT_SPREAD, G.EDLINLINE_FRAGMENT] diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs index c979644495b3d..73f876fdefa91 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs @@ -66,80 +66,99 @@ data TableMeta fetchTableMeta :: Q.Tx [TableMeta] fetchTableMeta = do res <- Q.listQ [Q.sql| - SELECT - t.table_schema, - t.table_name, - t.table_oid, - coalesce(c.columns, '[]') as columns, - coalesce(f.constraints, '[]') as constraints - FROM - (SELECT - c.oid as table_oid, - c.relname as table_name, - n.nspname as table_schema - FROM - pg_catalog.pg_class c - JOIN - pg_catalog.pg_namespace as n - ON - c.relnamespace = n.oid - ) t - LEFT OUTER JOIN - (SELECT - table_schema, - table_name, - json_agg((SELECT r FROM (SELECT column_name, - json_build_object( - 'oid', - td.atttypid :: int, - 'dimension', - td.attndims - ) AS data_type, - ordinal_position, - is_nullable::boolean) r)) as columns - FROM - information_schema.columns c + SELECT + t.table_schema, + t.table_name, + t.table_oid, + coalesce(c.columns, '[]') as columns, + coalesce(f.constraints, '[]') as constraints + FROM + ( + SELECT + c.oid as table_oid, + c.relname as table_name, + n.nspname as table_schema + FROM + pg_catalog.pg_class c + JOIN pg_catalog.pg_namespace as n ON c.relnamespace = n.oid + ) t LEFT OUTER JOIN ( - select pc.relnamespace, - pc.relname, - pa.attname, - pa.attndims, - pa.atttypid, - pa.atttypmod - from pg_attribute pa - left join pg_class pc - on pa.attrelid = pc.oid - ) td on - ( c.table_schema::regnamespace::oid = td.relnamespace - AND c.table_name = td.relname - AND c.column_name = td.attname + SELECT + table_schema, + table_name, + json_agg( + ( + SELECT + r + FROM + ( + SELECT + column_name, + json_build_object( + 'oid', + td.atttypid :: int, + 'dimension', + td.attndims + ) AS data_type, + ordinal_position, + is_nullable :: boolean + ) r + ) + ) as columns + FROM + information_schema.columns c + LEFT OUTER JOIN ( + select + pc.relnamespace, + pc.relname, + pa.attname, + pa.attndims, + pa.atttypid, + pa.atttypmod + from + pg_attribute pa + left join pg_class pc on pa.attrelid = pc.oid + ) td on ( + c.table_schema :: regnamespace :: oid = td.relnamespace + AND c.table_name = td.relname + AND c.column_name = td.attname + ) + GROUP BY + table_schema, + table_name + ) c ON ( + t.table_schema = c.table_schema + AND t.table_name = c.table_name ) - GROUP BY - table_schema, table_name) c - ON (t.table_schema = c.table_schema AND t.table_name = c.table_name) - LEFT OUTER JOIN - (SELECT - tc.table_schema, - tc.table_name, - json_agg( - json_build_object( - 'name', tc.constraint_name, - 'oid', r.oid::integer, - 'type', tc.constraint_type - ) - ) as constraints - FROM - information_schema.table_constraints tc - JOIN pg_catalog.pg_constraint r - ON tc.constraint_name = r.conname - GROUP BY - table_schema, table_name) f - ON (t.table_schema = f.table_schema AND t.table_name = f.table_name) - WHERE - t.table_schema NOT LIKE 'pg_%' - AND t.table_schema <> 'information_schema' - AND t.table_schema <> 'hdb_catalog' - |] () False + LEFT OUTER JOIN ( + SELECT + tc.table_schema, + tc.table_name, + json_agg( + json_build_object( + 'name', + tc.constraint_name, + 'oid', + r.oid :: integer, + 'type', + tc.constraint_type + ) + ) as constraints + FROM + information_schema.table_constraints tc + JOIN pg_catalog.pg_constraint r ON tc.constraint_name = r.conname + GROUP BY + table_schema, + table_name + ) f ON ( + t.table_schema = f.table_schema + AND t.table_name = f.table_name + ) + WHERE + t.table_schema NOT LIKE 'pg_%' + AND t.table_schema <> 'information_schema' + AND t.table_schema <> 'hdb_catalog' + |] () False forM res $ \(ts, tn, toid, cols, constrnts) -> return $ TableMeta toid (QualifiedObject ts tn) (Q.getAltJ cols) (Q.getAltJ constrnts) diff --git a/server/src-lib/Hasura/RQL/DML/Internal.hs b/server/src-lib/Hasura/RQL/DML/Internal.hs index 20e9d97379518..1f78e377ec1e4 100644 --- a/server/src-lib/Hasura/RQL/DML/Internal.hs +++ b/server/src-lib/Hasura/RQL/DML/Internal.hs @@ -217,12 +217,8 @@ convPartialSQLExp f = \case sessVarFromCurrentSetting :: (Applicative f) => PGColType -> SessVar -> f S.SQLExp -sessVarFromCurrentSetting columnType sessVar = - pure $ sessVarFromCurrentSetting' columnType sessVar - -sessVarFromCurrentSetting' :: PGColType -> SessVar -> S.SQLExp -sessVarFromCurrentSetting' columnType sessVar = - S.annotateExp columnType $ withGeom columnType $ +sessVarFromCurrentSetting columnType sessVar = pure $ + S.annotateExp columnType $ withGeoVal columnType $ S.SEOpApp (S.SQLOp "->>") [curSess, S.SELit $ T.toLower sessVar] where curSess = S.SEUnsafe "current_setting('hasura.user')::json" @@ -257,32 +253,33 @@ dmlTxErrorHandler p2Res = toJSONableExp :: Bool -> PGColType -> S.SQLExp -> S.SQLExp toJSONableExp strfyNum colTy expn = case pgColTyDetails colTy of - PGTyBase b -> toJSONableExp' strfyNum b expn - PGTyArray {} -> maybe expn (\ty -> toJSONableArrExp strfyNum ty expn) $ getArrayBaseTy colTy - _ -> expn + PGTyBase b -> toJSONableExpBase strfyNum b expn + PGTyArray{} -> maybe expn (\ty -> toJSONableArrExp strfyNum ty expn) $ + getArrayBaseTy colTy + _ -> expn toJSONableArrExp :: Bool -> PGColType -> S.SQLExp -> S.SQLExp toJSONableArrExp strfyNum bcolTy expn = case pgColTyDetails bcolTy of - PGTyBase b -> toJSONableArrExp' strfyNum b expn + PGTyBase b -> toJSONableArrExpBase strfyNum b expn PGTyDomain b -> toJSONableExp strfyNum b expn _ -> expn -toJSONableArrExp' :: Bool -> PGBaseColType -> S.SQLExp -> S.SQLExp -toJSONableArrExp' strfyNum bColTy expn - | bColTy == PGGeometry || bColTy == PGGeography = - applyAsGeoJSONArr expn `S.SETyAnn` jsonArrType - | isBigNum' bColTy && strfyNum = - expn `S.SETyAnn` textArrType - | otherwise = expn - -toJSONableExp' :: Bool -> PGBaseColType -> S.SQLExp -> S.SQLExp -toJSONableExp' strfyNum colTy expn +toJSONableExpBase :: Bool -> PGBaseColType -> S.SQLExp -> S.SQLExp +toJSONableExpBase strfyNum colTy expn | colTy == PGGeometry || colTy == PGGeography = applyAsGeoJSON expn - | isBigNum' colTy && strfyNum = + | isBigNumBase colTy && strfyNum = expn `S.SETyAnn` textType | otherwise = expn +toJSONableArrExpBase :: Bool -> PGBaseColType -> S.SQLExp -> S.SQLExp +toJSONableArrExpBase strfyNum bColTy expn + | bColTy == PGGeometry || bColTy == PGGeography = + applyAsGeoJSONArr expn `S.SETyAnn` jsonArrType + | isBigNumBase bColTy && strfyNum = + expn `S.SETyAnn` textArrType + | otherwise = expn + -- validate headers validateHeaders :: (UserInfoM m, QErrM m) => [T.Text] -> m () validateHeaders depHeaders = do diff --git a/server/src-lib/Hasura/RQL/GBoolExp.hs b/server/src-lib/Hasura/RQL/GBoolExp.hs index 921efda952662..103a59fbf69c9 100644 --- a/server/src-lib/Hasura/RQL/GBoolExp.hs +++ b/server/src-lib/Hasura/RQL/GBoolExp.hs @@ -81,8 +81,8 @@ parseOpExp parser fim (PGColInfoG cn colTy _) (opStr, val) = withErrPath $ "$is_contained_by" -> jsonbOrArrOp $ AContainedIn <$> parseOne "_is_contained_by" -> jsonbOrArrOp $ AContainedIn <$> parseOne - "_has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy (baseTy PGText) - "$has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy (baseTy PGText) + "_has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy textColTy + "$has_key" -> jsonbOnlyOp $ AHasKey <$> parseWithTy textColTy --FIXME:- Parse a session variable as text array values --TODO:- Add following commented operators after fixing above said @@ -165,7 +165,7 @@ parseOpExp parser fim (PGColInfoG cn colTy _) (opStr, val) = withErrPath $ jsonbOnlyOp m = case pgColTyDetails colTy of PGTyBase PGJSONB -> m - _ -> throwError $ buildMsg colTy [baseTy PGJSONB] + _ -> throwError $ buildMsg colTy [jsonbColTy] parseGeometryOp f = geometryOp colTy >> f <$> parseOne @@ -175,17 +175,16 @@ parseOpExp parser fim (PGColInfoG cn colTy _) (opStr, val) = withErrPath $ parseSTDWithinObj = case colTy of PGGeomTy{} -> do DWithinGeomOp distVal fromVal <- parseVal - dist <- withPathK "distance" $ parser (baseTy PGFloat) distVal + dist <- withPathK "distance" $ parser floatColTy distVal from <- withPathK "from" $ parser colTy fromVal return $ ASTDWithinGeom $ DWithinGeomOp dist from PGGeogTy{} -> do DWithinGeogOp distVal fromVal sphVal <- parseVal - dist <- withPathK "distance" $ parser (baseTy PGFloat) distVal + dist <- withPathK "distance" $ parser floatColTy distVal from <- withPathK "from" $ parser colTy fromVal - useSpheroid <- withPathK "use_spheroid" $ - parser (baseTy PGBoolean) sphVal + useSpheroid <- withPathK "use_spheroid" $ parser boolColTy sphVal return $ ASTDWithinGeog $ DWithinGeogOp dist from useSpheroid - _ -> throwError $ buildMsg colTy [baseTy PGGeometry, baseTy PGGeography] + _ -> throwError $ buildMsg colTy [geometryColTy, geographyColTy] decodeAndValidateRhsCol = parseVal >>= validateRhsCol @@ -200,11 +199,11 @@ parseOpExp parser fim (PGColInfoG cn colTy _) (opStr, val) = withErrPath $ geometryOp PGGeomTy{} = return () geometryOp ty = - throwError $ buildMsg ty [baseTy PGGeometry] + throwError $ buildMsg ty [geometryColTy] geometryOrGeographyOp PGGeomTy{} = return () geometryOrGeographyOp PGGeogTy{} = return () geometryOrGeographyOp ty = - throwError $ buildMsg ty [baseTy PGGeometry, baseTy PGGeography] + throwError $ buildMsg ty [geometryColTy, geographyColTy] parseWithTy ty = parser ty val parseOne = parseWithTy colTy @@ -239,12 +238,13 @@ buildMsg ty expTys = textOnlyOp :: MonadError QErr m => PGColType -> m () textOnlyOp colTy = case pgColTyDetails colTy of - PGTyBase b -> textOnlyOp' b + PGTyBase b -> textOnlyOpBase b _ -> onlyTxtTyErr where - textOnlyOp' PGText = return () - textOnlyOp' PGVarchar = return () - textOnlyOp' _ = onlyTxtTyErr + textOnlyOpBase PGText = return () + textOnlyOpBase PGVarchar = return () + textOnlyOpBase _ = onlyTxtTyErr + onlyTxtTyErr = throwError $ buildMsg colTy $ baseTy <$> [PGVarchar, PGText] -- This convoluted expression instead of col = val @@ -386,10 +386,10 @@ mkColCompExp qual lhsCol = \case mkQCol = S.SEQIden . S.QIden qual . toIden lhs = mkQCol lhsCol - txtEncoder' = fromEncPGVal . txtEncodePGVal' + txtEncoderBase = fromEncPGVal . txtEncodePGValBase - toTextArray arr = - S.SETyAnn (S.SEArray $ map (txtEncoder' . PGValKnown . PGValText) arr) textArrType + toTextArray arr = flip S.SETyAnn textArrType $ S.SEArray $ + flip map arr $ txtEncoderBase . PGValKnown . PGValText mkGeomOpBe fn v = applySQLFn fn [lhs, v] diff --git a/server/src-lib/Hasura/RQL/Types/Common.hs b/server/src-lib/Hasura/RQL/Types/Common.hs index 38d8a8a5ddbf9..1e85223ba7e70 100644 --- a/server/src-lib/Hasura/RQL/Types/Common.hs +++ b/server/src-lib/Hasura/RQL/Types/Common.hs @@ -58,7 +58,7 @@ $(deriveJSON (aesonDrop 4 camelCase) ''PGDomBaseTyInfo ) type PGCompTyFldMap = [Map.HashMap PGTyFldName PGColOidInfo] -data PGTyInfo' +data PGTyInfoDet = PGTBase | PGTRange | PGTPseudo @@ -73,7 +73,7 @@ data PGTyInfo { ptiName :: !QualifiedType , ptiOid :: !PQ.Oid , ptiSqlName :: !AnnType - , ptiDetail :: !PGTyInfo' + , ptiDetail :: !PGTyInfoDet } deriving (Show, Eq) data PGColOidInfo @@ -125,21 +125,13 @@ resolveColType tyMaps ty = onNothing (getPGColTy tyMaps ty) $ throw500 $ "Could not find Postgres type for oid " <> T.pack (show $ pcoiOid ty) --- resolveColTypes --- :: MonadError QErr m => PGTyInfoMaps -> [PGColOidInfo] -> m [PGColType] --- resolveColTypes maps tys = --- forM tys $ \t -> onNothing (getPGColTy maps t) $ throw500 $ errMsg t --- where --- errMsg x = --- "Could not find Postgres type for oid " <> T.pack (show $ pcoiOid x) - $(deriveJSON (aesonDrop 4 snakeCase) ''PGColOidInfo) $(deriveJSON (aesonDrop 4 snakeCase) { constructorTagModifier = snakeCase . drop 3 , sumEncoding = TaggedObject "type" "detail" } - ''PGTyInfo') + ''PGTyInfoDet) $(deriveJSON (aesonDrop 3 snakeCase) ''PGTyInfo) data PGColInfoG a diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index 87bc6919170d4..697e713fc2630 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -25,7 +25,6 @@ module Hasura.RQL.Types.SchemaCache , isForeignKey , addTableToCache , modTableInCache - -- , modPGTyCache , delTableFromCache , WithDeps @@ -47,7 +46,6 @@ module Hasura.RQL.Types.SchemaCache , isPGColInfo , getColInfos , RelInfo(..) - -- , addFldToCache , addColToCache , addRelToCache @@ -538,12 +536,6 @@ modTableCache tc = do sc <- askSchemaCache writeSchemaCache $ sc { scTables = tc } --- modPGTyCache :: (CacheRWM m) => PGTyCache -> m () --- modPGTyCache tm = do --- sc <- askSchemaCache --- writeSchemaCache $ sc { scTyMap = tm } - - addTableToCache :: (QErrM m, CacheRWM m) => TableInfo -> m () addTableToCache ti = do diff --git a/server/src-lib/Hasura/SQL/DML.hs b/server/src-lib/Hasura/SQL/DML.hs index 6a208a1ebe28c..c75820d32204b 100644 --- a/server/src-lib/Hasura/SQL/DML.hs +++ b/server/src-lib/Hasura/SQL/DML.hs @@ -266,9 +266,6 @@ data SQLExp | SECount !CountType deriving (Show, Eq) --- withTyAnn :: PGColType -> SQLExp -> SQLExp --- withTyAnn colTy v = SETyAnn v $ AnnType $ T.pack $ show colTy - instance J.ToJSON SQLExp where toJSON = J.toJSON . toSQLTxt diff --git a/server/src-lib/Hasura/SQL/Rewrite.hs b/server/src-lib/Hasura/SQL/Rewrite.hs index 01b0bc171398a..986114034065a 100644 --- a/server/src-lib/Hasura/SQL/Rewrite.hs +++ b/server/src-lib/Hasura/SQL/Rewrite.hs @@ -87,7 +87,7 @@ uFromItem fromItem = case fromItem of S.FISimple t <$> mapM addAlias alM S.FIIden iden -> S.FIIden <$> return iden - S.FIFunc f args alM -> do + S.FIFunc f args alM -> S.FIFunc f <$> mapM uSqlExp args <*> mapM addAlias alM S.FIUnnest args als cols -> S.FIUnnest <$> mapM uSqlExp args <*> addAlias als <*> mapM uSqlExp cols diff --git a/server/src-lib/Hasura/SQL/Types.hs b/server/src-lib/Hasura/SQL/Types.hs index 706b5c69e8380..d7768cf4f7214 100644 --- a/server/src-lib/Hasura/SQL/Types.hs +++ b/server/src-lib/Hasura/SQL/Types.hs @@ -454,6 +454,27 @@ baseTy b = PGColType qualfdType (AnnType name) (pgBaseTyOid b)$ PGTyBase b qualfdType = QualifiedObject (SchemaName "pg_catalog") (PGTyName name) name = T.pack $ show b +integerColTy :: PGColType +integerColTy = baseTy PGInteger + +boolColTy :: PGColType +boolColTy = baseTy PGBoolean + +textColTy :: PGColType +textColTy = baseTy PGText + +jsonbColTy :: PGColType +jsonbColTy = baseTy PGJSONB + +floatColTy :: PGColType +floatColTy = baseTy PGFloat + +geometryColTy :: PGColType +geometryColTy = baseTy PGGeometry + +geographyColTy :: PGColType +geographyColTy = baseTy PGGeography + arrTyOfBaseQ :: PGBaseColType -> TH.Q TH.Exp arrTyOfBaseQ bct = case arrTyOfBase bct of Nothing -> fail $ "Could not find array type for base type " <> show bct @@ -506,13 +527,13 @@ pgBaseTyOid (PGUnknown _) = PTI.auto isIntegerType :: PGColType -> Bool -isIntegerType = onBaseUDT False isIntegerType' +isIntegerType = onBaseUDT False isIntegerTypeBase isNumType :: PGColType -> Bool -isNumType = onBaseUDT False isNumType' +isNumType = onBaseUDT False isNumTypeBase isJSONBType :: PGColType -> Bool -isJSONBType = onBaseUDT False isJSONBType' +isJSONBType = onBaseUDT False isJSONBTypeBase isArrType :: PGColType -> Bool isArrType colTy = case pgColTyDetails (getUdt colTy) of @@ -535,7 +556,7 @@ pattern PGJSONBTy a b c = PGColType a b c (PGTyBase PGJSONB) isComparableType :: PGColType -> Bool isComparableType t = case pgColTyDetails (getUdt t) of PGTyArray a -> isComparableType a - PGTyBase b -> isComparableType' b + PGTyBase b -> isComparableTypeBase b PGTyEnum{} -> True _ -> False @@ -545,41 +566,35 @@ onBaseUDT def f t = case pgColTyDetails (getUdt t) of PGTyBase b -> f b _ -> def -isIntegerType' :: PGBaseColType -> Bool -isIntegerType' PGInteger = True -isIntegerType' PGSmallInt = True -isIntegerType' PGBigInt = True -isIntegerType' _ = False - -isNumType' :: PGBaseColType -> Bool -isNumType' PGFloat = True -isNumType' PGDouble = True -isNumType' PGNumeric = True -isNumType' ty = isIntegerType' ty - -isJSONBType' :: PGBaseColType -> Bool -isJSONBType' PGJSONB = True -isJSONBType' _ = False - -isComparableType' :: PGBaseColType -> Bool -isComparableType' PGJSON = False -isComparableType' PGJSONB = False -isComparableType' PGGeometry = False -isComparableType' PGGeography = False -isComparableType' PGBoolean = False -isComparableType' (PGUnknown _) = False -isComparableType' _ = True - -isBigNum' :: PGBaseColType -> Bool -isBigNum' = \case +isIntegerTypeBase :: PGBaseColType -> Bool +isIntegerTypeBase PGInteger = True +isIntegerTypeBase PGSmallInt = True +isIntegerTypeBase PGBigInt = True +isIntegerTypeBase _ = False + +isNumTypeBase :: PGBaseColType -> Bool +isNumTypeBase PGFloat = True +isNumTypeBase PGDouble = True +isNumTypeBase PGNumeric = True +isNumTypeBase ty = isIntegerTypeBase ty + +isJSONBTypeBase :: PGBaseColType -> Bool +isJSONBTypeBase PGJSONB = True +isJSONBTypeBase _ = False + +isComparableTypeBase :: PGBaseColType -> Bool +isComparableTypeBase PGJSON = False +isComparableTypeBase PGJSONB = False +isComparableTypeBase PGGeometry = False +isComparableTypeBase PGGeography = False +isComparableTypeBase PGBoolean = False +isComparableTypeBase (PGUnknown _) = False +isComparableTypeBase _ = True + +isBigNumBase :: PGBaseColType -> Bool +isBigNumBase = \case PGBigInt -> True PGBigSerial -> True PGNumeric -> True PGDouble -> True _ -> False - -isGeoType :: PGBaseColType -> Bool -isGeoType = \case - PGGeometry -> True - PGGeography -> True - _ -> False diff --git a/server/src-lib/Hasura/SQL/Value.hs b/server/src-lib/Hasura/SQL/Value.hs index bb32c97cc1651..250af9b6e9cb7 100644 --- a/server/src-lib/Hasura/SQL/Value.hs +++ b/server/src-lib/Hasura/SQL/Value.hs @@ -28,7 +28,7 @@ import qualified Database.PostgreSQL.LibPQ as PQ import qualified PostgreSQL.Binary.Encoding as PE -data PGColValue = PGColValue !PQ.Oid PGColValue' +data PGColValue = PGColValue !PQ.Oid PGColValueDet deriving (Show, Eq) type PGElemOid = PQ.Oid @@ -42,7 +42,7 @@ pattern PGTxtVal o x = PGColValue o (PGValBase (PGValKnown (PGValText x))) pattern PGVarcharVal :: PQ.Oid -> Text -> PGColValue pattern PGVarcharVal o x = PGColValue o (PGValBase (PGValKnown (PGValVarchar x))) -data PGColValue' +data PGColValueDet = PGValBase !PGBaseColValue | PGValDomain !PGColValue | PGValArray !PGElemOid !(V.Vector PGColValue) @@ -78,11 +78,11 @@ data PGBCKnown | PGValGeo !GeometryWithCRS deriving (Show, Eq) -data PGColValueBin = PGColValueBin PQ.Oid PGColValueBin' +data PGColValueBin = PGColValueBin PQ.Oid PGColValueBinDet type ElemOid = PQ.Oid -data PGColValueBin' +data PGColValueBinDet = PGValBaseBin !PGBCKnown | PGValDomainBin !PGColValueBin | PGValArrayBin ElemOid !(V.Vector PGColValueBin) @@ -138,10 +138,11 @@ txtEncodePGValG f (PGColValue _ x) = case x of PGNull -> TENull txtEncodePGVal :: PGColValue -> TxtEncodedPGVal -txtEncodePGVal = txtEncodePGValG txtEncodePGVal' +txtEncodePGVal = txtEncodePGValG txtEncodePGValBase -txtEncodePGVal' :: PGBaseColValue -> TxtEncodedPGVal -txtEncodePGVal' (PGValKnown colVal) = case colVal of +txtEncodePGValBase :: PGBaseColValue -> TxtEncodedPGVal +txtEncodePGValBase (PGValUnknown t) = TELit t +txtEncodePGValBase (PGValKnown colVal) = case colVal of PGValInteger i -> TELit $ T.pack $ show i PGValSmallInt i -> TELit $ T.pack $ show i PGValBigInt i -> TELit $ T.pack $ show i @@ -157,15 +158,12 @@ txtEncodePGVal' (PGValKnown colVal) = case colVal of TELit $ T.pack $ formatTime defaultTimeLocale "%FT%T%QZ" u PGValTimeTZ (ZonedTimeOfDay tod tz) -> TELit $ T.pack (show tod ++ timeZoneOffsetString tz) - --PGNull _ -> - -- S.SEUnsafe "NULL" PGValJSON (Q.JSON j) -> TELit $ TL.toStrict $ AE.encodeToLazyText j PGValJSONB (Q.JSONB j) -> TELit $ TL.toStrict $ AE.encodeToLazyText j PGValGeo o -> TELit $ TL.toStrict $ AE.encodeToLazyText o -txtEncodePGVal' (PGValUnknown t) = TELit t paTxtEncBase :: PGBCKnown -> (PQ.Oid, T.Text) paTxtEncBase c = case c of @@ -317,18 +315,22 @@ parsePGValue pct val = case pgColTyDetails pct of PGTyRange{} -> parseAsRange val PGTyBase pbct -> parseAsBase pbct val where - parseAsVal :: (FromJSON a) => (a -> PGColValue') -> Value -> AT.Parser PGColValue parseAsVal g v = let oid = pgColTyOid pct asVal = PGColValue oid . g in asVal <$> parseJSON v + parseAsComposite = parseAsVal PGValComposite + parseAsEnum = parseAsVal PGValEnum + parseAsRange = parseAsVal PGValRange - parseAsArray bct v = allowPGEncStr $ (flip $ withArray "[PGColValue]") v $ \a -> do - let elemOid = maybe (pgColTyOid bct) pgTyOid $ getArrayBaseTy pct - asArr = PGColValue (pgTyOid pct) . PGValArray elemOid - asArr <$> mapM (parsePGValue bct) a + + parseAsArray bct v = + allowPGEncStr $ (flip $ withArray "[PGColValue]") v $ \arr -> do + let elemOid = maybe (pgColTyOid bct) pgTyOid $ getArrayBaseTy pct + asArr = PGColValue (pgTyOid pct) . PGValArray elemOid + asArr <$> mapM (parsePGValue bct) arr asUnknown bct v = PGColValue (pgColTyOid bct) $ PGValBase $ PGValUnknown v @@ -390,51 +392,49 @@ applyAsGeoJSON expn = ] Nothing `S.SETyAnn` jsonType -applyAsGeoJSONArr :: S.SQLExp -> S.SQLExp -applyAsGeoJSONArr v = +withGeoJSONArr :: (S.SQLExp -> S.SQLExp) -> S.SQLExp -> S.SQLExp +withGeoJSONArr f v = S.SESelect S.mkSelect - { S.selExtr = - [ flip S.Extractor Nothing $ S.SEFnApp "array_agg" [applyAsGeoJSON $ S.SEIden $ toIden unnestF] Nothing - ] - , S.selFrom = Just $ S.FromExp [S.mkFuncFromItem qualUnnestF [v]] - } `S.SETyAnn` jsonArrType + { S.selExtr = pure $ flip S.Extractor Nothing $ S.SEFnApp "array_agg" + [f $ S.mkQIdenExp unnestTab unnestCol] + Nothing + , S.selFrom = Just $ S.FromExp $ pure $ S.FIUnnest [v] + (S.Alias unnestTab) [S.SEIden unnestCol] + } where - qualUnnestF = QualifiedObject catalogSchema unnestF - unnestF = FunctionName "unnest" + unnestCol = Iden "unnest_col" + unnestTab = Iden "unnest_tab" + +applyAsGeoJSONArr :: S.SQLExp -> S.SQLExp +applyAsGeoJSONArr = + flip S.SETyAnn jsonArrType . withGeoJSONArr applyAsGeoJSON toPrepParam :: Int -> PGColType -> S.SQLExp -toPrepParam i ty = withGeom ty $ S.SEPrep i +toPrepParam i ty = withGeoVal ty $ S.SEPrep i -withGeom :: PGColType -> S.SQLExp -> S.SQLExp -withGeom ty@(PGColType _ _ _ d) = case d of - PGTyBase x -> bool id applyGeomFromGeoJson $ isBaseTyGeo x +withGeoVal :: PGColType -> S.SQLExp -> S.SQLExp +withGeoVal ty = case dets of + PGTyBase x -> bool id applyGeomFromGeoJson $ isBaseTyGeo x PGTyArray{} -> case getArrayBaseTy ty of - Just (PGColType _ _ _ (PGTyBase b)) -> bool id applyArrGeomFromGeoJson $ isBaseTyGeo b - _ -> id - _ -> id + Just (PGColType _ _ _ (PGTyBase b)) -> bool id applyArrGeomFromGeoJson $ + isBaseTyGeo b + _ -> id + _ -> id where + dets = pgColTyDetails ty isBaseTyGeo b = case b of PGGeometry -> True PGGeography -> True _ -> False - applyArrGeomFromGeoJson v = - S.SESelect $ S.mkSelect - { S.selExtr = - [ flip S.Extractor Nothing $ S.SEFnApp "array_agg" [applyGeomFromGeoJson $ S.SEIden $ toIden unnestF] Nothing - ] - , S.selFrom = Just $ S.FromExp [S.mkFuncFromItem qualUnnestF [v]] - } - qualUnnestF = - QualifiedObject catalogSchema unnestF - unnestF = - FunctionName "unnest" + + applyArrGeomFromGeoJson = withGeoJSONArr applyGeomFromGeoJson toTxtValue :: PGColType -> PGColValue -> S.SQLExp toTxtValue ty val = S.annotateExp ty txtVal where - txtVal = withGeom ty $ txtEncoder val + txtVal = withGeoVal ty $ txtEncoder val pgColValueToInt :: PGColValue -> Maybe Int pgColValueToInt (PGColValue _ x) = case x of From d80ac1851b7243faa64b9ab07710afcc35373e05 Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Tue, 21 May 2019 17:57:51 +0530 Subject: [PATCH 12/13] [console] fix delete function --- .../components/Services/Data/Function/customFunctionReducer.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/console/src/components/Services/Data/Function/customFunctionReducer.js b/console/src/components/Services/Data/Function/customFunctionReducer.js index d1c32529c007e..3819b8fd15513 100644 --- a/console/src/components/Services/Data/Function/customFunctionReducer.js +++ b/console/src/components/Services/Data/Function/customFunctionReducer.js @@ -182,7 +182,7 @@ const deleteFunctionSql = () => { let functionString = '('; inputArgTypes.forEach((i, index) => { functionString += - i + ' ' + (index === inputArgTypes.length - 1 ? ')' : ','); + i.name + ' ' + (index === inputArgTypes.length - 1 ? ')' : ','); }); functionWSchemaName += functionString; } From 0daab141fc82a8ff0024ce19e5d640d11d8204b6 Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Tue, 21 May 2019 19:13:18 +0530 Subject: [PATCH 13/13] fix console cypress tests --- console/cypress/integration/data/modify/spec.js | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/console/cypress/integration/data/modify/spec.js b/console/cypress/integration/data/modify/spec.js index ad0708362282e..589302532c59e 100644 --- a/console/cypress/integration/data/modify/spec.js +++ b/console/cypress/integration/data/modify/spec.js @@ -192,7 +192,7 @@ export const passCreateUniqueKey = () => { cy.get(getElementFromAlias('unique-key-0-column-0')).select('0'); cy.get(getElementFromAlias('unique-key-0-column-1')).select('1'); cy.get(getElementFromAlias('modify-table-unique-key-0-save')).click(); - cy.wait(5000); + cy.wait(10000); cy.get('div').contains( `${getTableName(0, testName)}_id_${getColName(0)}_key` ); @@ -202,14 +202,14 @@ export const passModifyUniqueKey = () => { cy.get(getElementFromAlias('modify-table-edit-unique-key-0')).click(); cy.get(getElementFromAlias('remove-uk-0-column-0')).click(); cy.get(getElementFromAlias('modify-table-unique-key-0-save')).click(); - cy.wait(5000); + cy.wait(10000); cy.get('div').contains(`${getTableName(0, testName)}_${getColName(0)}_key`); }; export const passRemoveUniqueKey = () => { cy.get(getElementFromAlias('modify-table-edit-unique-key-0')).click(); cy.get(getElementFromAlias('modify-table-unique-key-0-remove')).click(); - cy.wait(5000); + cy.wait(10000); }; export const passMTDeleteCol = () => {