diff --git a/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs b/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs index 84eaf62ea2ccd..d7f73a0058487 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs @@ -80,7 +80,7 @@ parseColExp nt n val = do fldInfo <- getFldInfo nt n case fldInfo of Left pgColInfo -> RA.AVCol pgColInfo <$> parseOpExps val - Right (relInfo, permExp, _) -> do + Right (relInfo, permExp, _, _) -> do relBoolExp <- parseBoolExp val return $ RA.AVRel relInfo relBoolExp permExp diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Context.hs b/server/src-lib/Hasura/GraphQL/Resolve/Context.hs index b80305fd99d8a..1a380a4ee5f32 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Context.hs @@ -42,7 +42,7 @@ import Hasura.SQL.Value import qualified Hasura.SQL.DML as S type FieldMap - = Map.HashMap (G.NamedType, G.Name) (Either PGColInfo (RelInfo, S.BoolExp, Maybe Int)) + = Map.HashMap (G.NamedType, G.Name) (Either PGColInfo (RelInfo, S.BoolExp, Maybe Int, Bool)) data OrdTy = OAsc @@ -64,7 +64,7 @@ type OrdByResolveCtx getFldInfo :: (MonadError QErr m, MonadReader r m, Has FieldMap r) - => G.NamedType -> G.Name -> m (Either PGColInfo (RelInfo, S.BoolExp, Maybe Int)) + => G.NamedType -> G.Name -> m (Either PGColInfo (RelInfo, S.BoolExp, Maybe Int, Bool)) getFldInfo nt n = do fldMap <- asks getter onNothing (Map.lookup (nt,n) fldMap) $ diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index 03b5d5b0301db..f94f764d874d4 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -46,7 +46,7 @@ convertReturning ty selSet = case _fName fld of "__typename" -> return $ RR.RExp $ G.unName $ G.unNamedType ty _ -> do - PGColInfo col colTy <- getPGColInfo ty $ _fName fld + PGColInfo col colTy _ <- getPGColInfo ty $ _fName fld return $ RR.RCol (col, colTy) convertMutResp diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs index b7c50711e310f..13e4a3fd49d50 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs @@ -42,8 +42,8 @@ fromSelSet fldTy flds = _ -> do fldInfo <- getFldInfo fldTy fldName case fldInfo of - Left (PGColInfo pgCol colTy) -> return (rqlFldName, RS.FCol (pgCol, colTy)) - Right (relInfo, tableFilter, tableLimit) -> do + Left (PGColInfo pgCol colTy _) -> return (rqlFldName, RS.FCol (pgCol, colTy)) + Right (relInfo, tableFilter, tableLimit, _) -> do let relTN = riRTable relInfo relSelData <- fromField relTN tableFilter tableLimit fld let annRel = RS.AnnRel (riName relInfo) (riType relInfo) @@ -93,7 +93,7 @@ parseOrderBy v = do -- return $ map convOrdByElem enums -- undefined where - convOrdByElem (PGColInfo col _, ordTy, nullsOrd) = + convOrdByElem (PGColInfo col _ _, ordTy, nullsOrd) = S.OrderByItem (Left col) (Just $ convOrdTy ordTy) (Just $ convNullsOrd nullsOrd) diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index f60a3adc23e3b..7450b5ecc303b 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -83,7 +83,7 @@ instance Monoid TyAgg where mempty = TyAgg Map.empty Map.empty Map.empty mappend = (<>) -type SelField = Either PGColInfo (RelInfo, S.BoolExp, Maybe Int) +type SelField = Either PGColInfo (RelInfo, S.BoolExp, Maybe Int, Bool) qualTableToName :: QualifiedTable -> G.Name qualTableToName = G.Name <$> \case @@ -95,7 +95,7 @@ isValidTableName = isValidName . qualTableToName isValidField :: FieldInfo -> Bool isValidField = \case - FIColumn (PGColInfo col _) -> isColEligible col + FIColumn (PGColInfo col _ _) -> isColEligible col FIRelationship (RelInfo rn _ _ remTab _) -> isRelEligible rn remTab where isColEligible = isValidName . G.Name . getPGColTxt @@ -114,6 +114,14 @@ mkValidConstraints = filter isValid isValid (TableConstraint _ n) = isValidName $ G.Name $ getConstraintTxt n +isRelNullable :: FieldInfoMap -> RelInfo -> Bool +isRelNullable fim ri = isNullable + where + lCols = map fst $ riMapping ri + allCols = getCols fim + lColInfos = flip filter allCols $ \ci -> pgiName ci `elem` lCols + isNullable = any pgiIsNullable lColInfos + mkCompExpName :: PGColType -> G.Name mkCompExpName pgColTy = G.Name $ T.pack (show pgColTy) <> "_comparison_exp" @@ -175,11 +183,14 @@ mkCompExpInp colTy = ] mkPGColFld :: PGColInfo -> ObjFldInfo -mkPGColFld (PGColInfo colName colTy) = +mkPGColFld (PGColInfo colName colTy isNullable) = ObjFldInfo Nothing n Map.empty ty where n = G.Name $ getPGColTxt colName - ty = G.toGT $ mkScalarTy colTy + ty = bool notNullTy nullTy isNullable + scalarTy = mkScalarTy colTy + notNullTy = G.toGT $ G.toNT scalarTy + nullTy = G.toGT scalarTy -- where: table_bool_exp -- limit: Int @@ -211,8 +222,8 @@ array_relationship( object_relationship: remote_table -} -mkRelFld :: RelInfo -> ObjFldInfo -mkRelFld (RelInfo rn rTy _ remTab _) = case rTy of +mkRelFld :: RelInfo -> Bool -> ObjFldInfo +mkRelFld (RelInfo rn rTy _ remTab _) isNullable = case rTy of ArrRel -> ObjFldInfo (Just "An array relationship") (G.Name $ getRelTxt rn) (fromInpValL $ mkSelArgs remTab) @@ -220,8 +231,9 @@ mkRelFld (RelInfo rn rTy _ remTab _) = case rTy of ObjRel -> ObjFldInfo (Just "An object relationship") (G.Name $ getRelTxt rn) Map.empty - (G.toGT relTabTy) + objRelTy where + objRelTy = bool (G.toGT $ G.toNT relTabTy) (G.toGT relTabTy) isNullable relTabTy = mkTableTy remTab {- @@ -239,8 +251,8 @@ mkTableObj mkTableObj tn allowedFlds = mkObjTyInfo (Just desc) (mkTableTy tn) $ mapFromL _fiName flds where - flds = map (either mkPGColFld (mkRelFld . fst')) allowedFlds - fst' (a, _, _) = a + flds = map (either mkPGColFld mkRelFld') allowedFlds + mkRelFld' (relInfo, _, _, isNullable) = mkRelFld relInfo isNullable desc = G.Description $ "columns and relationships of " <>> tn @@ -341,13 +353,13 @@ mkBoolExpInp tn fields = ] mkFldExpInp = \case - Left (PGColInfo colName colTy) -> + Left (PGColInfo colName colTy _) -> mk (G.Name $ getPGColTxt colName) (mkCompExpTy colTy) - Right (RelInfo relName _ _ remTab _, _, _) -> + Right (RelInfo relName _ _ remTab _, _, _, _) -> mk (G.Name $ getRelTxt relName) (mkBoolExpTy remTab) mkPGColInp :: PGColInfo -> InpValInfo -mkPGColInp (PGColInfo colName colTy) = +mkPGColInp (PGColInfo colName colTy _) = InpValInfo Nothing (G.Name $ getPGColTxt colName) $ G.toGT $ mkScalarTy colTy @@ -747,7 +759,7 @@ mkOrdByCtx tn cols = mkOrdByEnumsOfCol :: PGColInfo -> [(G.Name, Text, (PGColInfo, OrdTy, NullsOrder))] -mkOrdByEnumsOfCol colInfo@(PGColInfo col _) = +mkOrdByEnumsOfCol colInfo@(PGColInfo col _ _) = [ ( colN <> "_asc" , "in the ascending order of " <> col <<> ", nulls last" , (colInfo, OAsc, NLast) @@ -831,7 +843,7 @@ mkGCtxRole' tn insColsM selFldsM updColsM delPermM constraints = nameFromSelFld = \case Left colInfo -> G.Name $ getPGColTxt $ pgiName colInfo - Right (relInfo, _, _) -> G.Name $ getRelTxt $ riName relInfo + Right (relInfo, _, _, _) -> G.Name $ getRelTxt $ riName relInfo -- helper mkColFldMap ty = mapFromL ((ty,) . nameFromSelFld) . map Left @@ -947,7 +959,11 @@ getSelFlds tableCache fields role selPermInfo = let remTableSelPermM = Map.lookup role (tiRolePermInfoMap remTableInfo) >>= _permSel return $ flip fmap remTableSelPermM $ - \rmSelPermM -> Right $ (relInfo, spiFilter rmSelPermM, spiLimit rmSelPermM) + \rmSelPermM -> Right ( relInfo + , spiFilter rmSelPermM + , spiLimit rmSelPermM + , isRelNullable fields relInfo + ) where allowedCols = spiCols selPermInfo getTabInfo tn = @@ -1011,7 +1027,7 @@ mkGCtxMapTable tableCache (TableInfo tn _ fields rolePerms constraints) = do allCols = map pgiName colInfos selFlds = flip map (toValidFieldInfos fields) $ \case FIColumn pgColInfo -> Left pgColInfo - FIRelationship relInfo -> Right (relInfo, noFilter, Nothing) + FIRelationship relInfo -> Right (relInfo, noFilter, Nothing, isRelNullable fields relInfo) noFilter = S.BELit True adminRootFlds = getRootFldsRole' tn constraints fields (Just (tn, [])) (Just (noFilter, Nothing, [])) diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs index 64c5d3e0bd24b..7f03aed1dea25 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs @@ -18,23 +18,24 @@ module Hasura.RQL.DDL.Schema.Diff , getSchemaChangeDeps ) where +import Hasura.Prelude import Hasura.RQL.Types import Hasura.SQL.Types -import Hasura.Prelude -import qualified Database.PG.Query as Q +import qualified Database.PG.Query as Q import Data.Aeson.Casing import Data.Aeson.TH -import qualified Data.HashMap.Strict as M -import qualified Data.HashSet as HS +import qualified Data.HashMap.Strict as M +import qualified Data.HashSet as HS data PGColMeta = PGColMeta { pcmColumnName :: !PGCol , pcmOrdinalPosition :: !Int , pcmDataType :: !PGColType + , pcmIsNullable :: !Bool } deriving (Show, Eq) $(deriveJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''PGColMeta) @@ -80,7 +81,7 @@ fetchTableMeta = do (SELECT table_schema, table_name, - json_agg((SELECT r FROM (SELECT column_name, udt_name AS data_type, ordinal_position) r)) as columns + json_agg((SELECT r FROM (SELECT column_name, udt_name AS data_type, ordinal_position, is_nullable::boolean) r)) as columns FROM information_schema.columns GROUP BY @@ -141,8 +142,8 @@ getTableDiff oldtm newtm = existingCols = getOverlap pcmOrdinalPosition oldCols newCols - pcmToPci (PGColMeta colName _ colType) - = PGColInfo colName colType + pcmToPci (PGColMeta colName _ colType isNullable) + = PGColInfo colName colType isNullable alteredCols = flip map (filter (uncurry (/=)) existingCols) $ \(pcmo, pcmn) -> diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs index 9bbc6d62c5606..318c1bf096495 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs @@ -62,7 +62,7 @@ getTableInfo qt@(QualifiedTable sn tn) isSystemDefined = do -- Fetch the column details colData <- Q.catchE defaultTxErrorHandler $ Q.listQ [Q.sql| - SELECT column_name, to_json(udt_name) + SELECT column_name, to_json(udt_name), is_nullable::boolean FROM information_schema.columns WHERE table_schema = $1 AND table_name = $2 @@ -76,7 +76,8 @@ getTableInfo qt@(QualifiedTable sn tn) isSystemDefined = do AND table_name = $2 |] (sn, tn) False return $ mkTableInfo qt isSystemDefined rawConstraints $ - map (fmap Q.getAltJ) colData + flip map colData $ \(colName, Q.AltJ colTy, isNull) + -> (colName, colTy, isNull) newtype TrackTable = TrackTable @@ -142,7 +143,7 @@ processTableChanges ti tableDiff = do delFldFromCache (fromPGCol droppedCol) tn -- In the newly added columns check that there is no conflict with relationships - forM_ addedCols $ \colInfo@(PGColInfo colName _) -> + forM_ addedCols $ \colInfo@(PGColInfo colName _ _) -> case M.lookup (fromPGCol colName) $ tiFieldInfoMap ti of Just (FIRelationship _) -> throw400 AlreadyExists $ "cannot add column " <> colName @@ -152,7 +153,7 @@ processTableChanges ti tableDiff = do sc <- askSchemaCache -- for rest of the columns - forM_ alteredCols $ \(PGColInfo oColName oColTy, nci@(PGColInfo nColName nColTy)) -> + forM_ alteredCols $ \(PGColInfo oColName oColTy _, nci@(PGColInfo nColName nColTy _)) -> if | oColName /= nColName -> throw400 NotSupported $ "column renames are not yet supported : " <> tn <<> "." <>> oColName diff --git a/server/src-lib/Hasura/RQL/DML/Internal.hs b/server/src-lib/Hasura/RQL/DML/Internal.hs index 0640257979338..74a39677a4410 100644 --- a/server/src-lib/Hasura/RQL/DML/Internal.hs +++ b/server/src-lib/Hasura/RQL/DML/Internal.hs @@ -182,7 +182,7 @@ checkOnColExp :: (P1C m) => SelPermInfo -> AnnValS -> m AnnValS checkOnColExp spi annVal = case annVal of - AVCol pci@(PGColInfo cn _) opExps -> do + AVCol pci@(PGColInfo cn _ _) opExps -> do checkSelOnCol spi cn return $ AVCol pci opExps AVRel relInfo nesAnn _ -> do diff --git a/server/src-lib/Hasura/RQL/GBoolExp.hs b/server/src-lib/Hasura/RQL/GBoolExp.hs index c49b18872b616..713712b5f6b1a 100644 --- a/server/src-lib/Hasura/RQL/GBoolExp.hs +++ b/server/src-lib/Hasura/RQL/GBoolExp.hs @@ -227,7 +227,7 @@ parseOpExps -> PGColInfo -> Value -> m [OpExpG a] -parseOpExps valParser cim (PGColInfo cn colTy) (Object o) = +parseOpExps valParser cim (PGColInfo cn colTy _) (Object o) = forM (M.toList o) $ \(k, v) -> do op <- parseOp k case (op, v) of @@ -245,7 +245,7 @@ parseOpExps valParser cim (PGColInfo cn colTy) (Object o) = "incompatible column types : " <> cn <<> ", " <>> pgCol return $ OECol colOp pgCol (Right _, _) -> throw400 UnexpectedPayload "expecting a string for column operator" -parseOpExps valParser _ (PGColInfo _ colTy) val = do +parseOpExps valParser _ (PGColInfo _ colTy _) val = do annValOp <- parseAnnOpExpG valParser REQ colTy val return [OEVal annValOp] @@ -330,9 +330,9 @@ annColExp annColExp valueParser colInfoMap (ColExp fieldName colVal) = do colInfo <- askFieldInfo colInfoMap fieldName case colInfo of - FIColumn (PGColInfo _ PGJSON) -> + FIColumn (PGColInfo _ PGJSON _) -> throwError (err400 UnexpectedPayload "JSON column can not be part of where clause") - FIColumn (PGColInfo _ PGJSONB) -> + FIColumn (PGColInfo _ PGJSONB _) -> throwError (err400 UnexpectedPayload "JSONB column can not be part of where clause") FIColumn pgi -> AVCol pgi <$> parseOpExps valueParser colInfoMap pgi colVal @@ -356,7 +356,7 @@ convColRhs => BoolExpBuilder m a -> S.Qual -> AnnValO a -> m (AnnValG S.BoolExp) convColRhs bExpBuilder tableQual annVal = case annVal of - AVCol pci@(PGColInfo cn _) opExps -> do + AVCol pci@(PGColInfo cn _ _) opExps -> do let qualColExp = S.SEQIden $ S.QIden tableQual (toIden cn) bExps <- forM opExps $ \case OEVal annOpValExp -> bExpBuilder qualColExp annOpValExp diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index 1454ed0582db5..63a2616ea0558 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -179,8 +179,9 @@ type QTemplateCache = M.HashMap TQueryName QueryTemplateInfo data PGColInfo = PGColInfo - { pgiName :: !PGCol - , pgiType :: !PGColType + { pgiName :: !PGCol + , pgiType :: !PGColType + , pgiIsNullable :: !Bool } deriving (Show, Eq) $(deriveToJSON (aesonDrop 3 snakeCase) ''PGColInfo) @@ -371,13 +372,13 @@ data TableInfo $(deriveToJSON (aesonDrop 2 snakeCase) ''TableInfo) mkTableInfo :: QualifiedTable -> Bool -> [(ConstraintType, ConstraintName)] - -> [(PGCol, PGColType)] -> TableInfo + -> [(PGCol, PGColType, Bool)] -> TableInfo mkTableInfo tn isSystemDefined rawCons cols = TableInfo tn isSystemDefined colMap (M.fromList []) constraints where constraints = flip map rawCons $ uncurry TableConstraint colMap = M.fromList $ map f cols - f (cn, ct) = (fromPGCol cn, FIColumn $ PGColInfo cn ct) + f (cn, ct, b) = (fromPGCol cn, FIColumn $ PGColInfo cn ct b) type TableCache = M.HashMap QualifiedTable TableInfo -- info of all tables