hasura · shahidhk · Jul 11, 2019 · May 29, 2019 · May 29, 2019 · May 29, 2019
@@ -29,10 +29,9 @@ import           Hasura.GraphQL.Resolve.Mutation
 import           Hasura.GraphQL.Resolve.Select
 import           Hasura.GraphQL.Validate.Field
 import           Hasura.GraphQL.Validate.Types
-import           Hasura.RQL.DML.Internal           ( dmlTxErrorHandler
-                                                   , convPartialSQLExp
-                                                   , sessVarFromCurrentSetting
-                                                   )
+import           Hasura.RQL.DML.Internal           (convPartialSQLExp,
+                                                    dmlTxErrorHandler,
+                                                    sessVarFromCurrentSetting)
 import           Hasura.RQL.DML.Mutation
 import           Hasura.RQL.GBoolExp               (toSQLBoolExp)
 import           Hasura.RQL.Types
@@ -115,8 +114,9 @@ traverseInsObj rim (gName, annVal) defVal@(AnnInsObj cols objRels arrRels) =
       -- if relational insert input is 'null' then ignore
       -- return default value
       fmap (fromMaybe defVal) $ forM objM $ \obj -> do
-        let relName = RelName $ G.unName gName
+        let relNameM = RelName <$> mkNonEmptyText (G.unName gName)
             onConflictM = OMap.lookup "on_conflict" obj
+        relName <- onNothing relNameM $ throw500 "found empty GName String"
         dataVal <- onNothing (OMap.lookup "data" obj) $
                    throw500 "\"data\" object not found"
         relInfo <- onNothing (Map.lookup relName rim) $
@@ -280,7 +280,7 @@ validateInsert insCols objRels addCols = do
   forM_ objRels $ \relInfo -> do
     let lCols = map fst $ riMapping relInfo
         relName = riName relInfo
-        relNameTxt = getRelTxt relName
+        relNameTxt = relNameToTxt relName
         lColConflicts = lCols `intersect` (addCols <> insCols)
     withPathK relNameTxt $ unless (null lColConflicts) $ throwVE $
       "cannot insert object relation ship " <> relName
@@ -311,7 +311,7 @@ insertObjRel strfyNum role objRelIns =
     RelIns singleObjIns relInfo = objRelIns
     multiObjIns = singleToMulti singleObjIns
     relName = riName relInfo
-    relNameTxt = getRelTxt relName
+    relNameTxt = relNameToTxt relName
     mapCols = riMapping relInfo
     tn = riRTable relInfo
     allCols = _aiTableCols singleObjIns
@@ -352,7 +352,7 @@ insertArrRel strfyNum role resCols arrRelIns =
     RelIns multiObjIns relInfo = arrRelIns
     colMapping = riMapping relInfo
     tn = riRTable relInfo
-    relNameTxt = getRelTxt $ riName relInfo
+    relNameTxt = relNameToTxt $ riName relInfo
     mutFlds = [("affected_rows", RR.MCount)]
 
 -- | insert an object with object and array relationships

@@ -63,8 +63,7 @@ isValidCol :: PGCol -> Bool
 isValidCol = isValidName . G.Name . getPGColTxt
 
 isValidRel :: ToTxt a => RelName -> QualifiedObject a -> Bool
-isValidRel rn rt = isValidName (G.Name $ getRelTxt rn)
-                          && isValidObjectName rt
+isValidRel rn rt = isValidName (mkRelName rn) && isValidObjectName rt
 
 isValidField :: FieldInfo -> Bool
 isValidField = \case
@@ -114,10 +113,10 @@ mkColName :: PGCol -> G.Name
 mkColName (PGCol n) = G.Name n
 
 mkRelName :: RelName -> G.Name
-mkRelName (RelName r) = G.Name r
+mkRelName rn = G.Name $ relNameToTxt rn
 
 mkAggRelName :: RelName -> G.Name
-mkAggRelName (RelName r) = G.Name $ r <> "_aggregate"
+mkAggRelName rn = G.Name $ relNameToTxt rn <> "_aggregate"
 
 mkBoolExpName :: QualifiedTable -> G.Name
 mkBoolExpName tn =
@@ -225,13 +224,13 @@ 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
+      (mkRelName rn) Map.empty 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)
+      mkHsraObjFldInfo (Just "An array relationship") (mkRelName rn)
       (fromInpValL $ mkSelArgs remTab) arrRelTy
     arrRelTy = G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkTableTy remTab
     aggArrRelFld = mkHsraObjFldInfo (Just "An aggregated array relationship")
@@ -533,7 +532,7 @@ mkBoolExpInp tn fields =
       Left (PGColInfo colName colTy _) ->
         mk (mkColName colName) (mkCompExpTy colTy)
       Right (RelInfo relName _ _ remTab _, _, _, _, _) ->
-        mk (G.Name $ getRelTxt relName) (mkBoolExpTy remTab)
+        mk (mkRelName relName) (mkBoolExpTy remTab)
 
 mkPGColInp :: PGColInfo -> InpValInfo
 mkPGColInp (PGColInfo colName colTy _) =
@@ -937,13 +936,13 @@ mkInsInp tn insCols relInfoMap =
 
     relInps = flip map (Map.toList relInfoMap) $
       \(relName, relInfo) ->
-         let rty = riType relInfo
-             remoteQT = riRTable relInfo
-         in case rty of
-            ObjRel -> InpValInfo Nothing (G.Name $ getRelTxt relName) Nothing $
-                      G.toGT $ mkObjInsInpTy remoteQT
-            ArrRel -> InpValInfo Nothing (G.Name $ getRelTxt relName) Nothing $
-                      G.toGT $ mkArrInsInpTy remoteQT
+         let remoteQT = riRTable relInfo
+             tyMaker = case riType relInfo of
+               ObjRel -> mkObjInsInpTy
+               ArrRel -> mkArrInsInpTy
+         in  InpValInfo Nothing (mkRelName relName) Nothing $
+               G.toGT $ tyMaker remoteQT
+
 
 {-
 
@@ -1319,7 +1318,7 @@ mkGCtxRole' tn insPermM selPermM updColsM
     mkFld ty = \case
       Left ci -> [((ty, mkColName $ pgiName ci), Left ci)]
       Right (ri, allowAgg, perm, lim, _) ->
-        let relFld = ( (ty, G.Name $ getRelTxt $ riName ri)
+        let relFld = ( (ty, mkRelName $ riName ri)
                      , Right (ri, False, perm, lim)
                      )
             aggRelFld = ( (ty, mkAggRelName $ riName ri)

@@ -42,7 +42,7 @@ triggerTmplt = case parseGingerTmplt $(FE.embedStringFile "src-rsr/trigger.sql.j
   Right tmplt -> Just tmplt
 
 pgIdenTrigger:: Ops -> TriggerName -> T.Text
-pgIdenTrigger op trn = pgFmtIden (qualifyTriggerName op trn)
+pgIdenTrigger op trn = pgFmtIden . qualifyTriggerName op $ triggerNameToTxt trn
   where
     qualifyTriggerName op' trn' = "notify_hasura_" <> trn' <> "_" <> T.pack (show op')
 
@@ -61,7 +61,7 @@ getTriggerSql
   -> Maybe T.Text
 getTriggerSql op trn qt allCols strfyNum spec =
   let globalCtx =  HashMap.fromList
-                   [ (T.pack "NAME", trn)
+                   [ (T.pack "NAME", triggerNameToTxt trn)
                    , (T.pack "QUALIFIED_TRIGGER_NAME", pgIdenTrigger op trn)
                    , (T.pack "QUALIFIED_TABLE", toSQLTxt qt)
                    ]

@@ -82,9 +82,9 @@ type InsPermDef = PermDef InsPerm
 type CreateInsPerm = CreatePerm InsPerm
 
 buildViewName :: QualifiedTable -> RoleName -> PermType -> QualifiedTable
-buildViewName (QualifiedObject sn tn) (RoleName rTxt) pt =
+buildViewName (QualifiedObject sn tn) rn pt =
   QualifiedObject hdbViewsSchema $ TableName
-  (rTxt <> "__" <> T.pack (show pt) <> "__" <> snTxt <> "__" <> tnTxt)
+  (roleNameToTxt rn <> "__" <> T.pack (show pt) <> "__" <> snTxt <> "__" <> tnTxt)
   where
     snTxt = getSchemaTxt sn
     tnTxt = getTableTxt tn

@@ -34,7 +34,7 @@ addCollectionP2 (CollectionDef queryList) =
   withPathK "queries" $
     unless (null duplicateNames) $ throw400 NotSupported $
       "found duplicate query names "
-      <> T.intercalate ", " (map (T.dquote . unQueryName) duplicateNames)
+      <> T.intercalate ", " (map (T.dquote . unNonEmptyText . unQueryName) duplicateNames)
   where
     duplicateNames = duplicates $ map _lqName queryList
 

@@ -133,14 +133,13 @@ checkPermOnCol pt allowedCols pgCol = do
   unless (HS.member pgCol allowedCols) $
     throw400 PermissionDenied $ permErrMsg roleName
   where
-    permErrMsg (RoleName "admin") =
-      "no such column exists : " <>> pgCol
-    permErrMsg roleName =
-      mconcat
-      [ "role " <>> roleName
-      , " does not have permission to "
-      , permTypeToCode pt <> " column " <>> pgCol
-      ]
+    permErrMsg roleName
+      | roleName == adminRole = "no such column exists : " <>> pgCol
+      | otherwise = mconcat
+        [ "role " <>> roleName
+        , " does not have permission to "
+        , permTypeToCode pt <> " column " <>> pgCol
+        ]
 
 binRHSBuilder
   :: PGColType -> Value -> DMLP1 S.SQLExp

@@ -641,7 +641,7 @@ mkAggSelect :: AnnAggSel -> S.Select
 mkAggSelect annAggSel =
   prefixNumToAliases $ arrNodeToSelect bn extr $ S.BELit True
   where
-    aggSel = AnnRelG (RelName "root") [] annAggSel
+    aggSel = AnnRelG rootRelName [] annAggSel
     ArrNode extr _ bn =
       aggSelToArrNode (Iden "root") (FieldName "root") aggSel
 

@@ -104,7 +104,7 @@ askTabInfoFromTrigger trn = do
   let tabInfos = M.elems $ scTables sc
   liftMaybe (err400 NotExists errMsg) $ find (isJust.M.lookup trn.tiEventTriggerInfoMap) tabInfos
   where
-    errMsg = "event trigger " <> trn <<> " does not exist"
+    errMsg = "event trigger " <> triggerNameToTxt trn <<> " does not exist"
 
 askEventTriggerInfo
   :: (QErrM m, CacheRM m)
@@ -114,7 +114,7 @@ askEventTriggerInfo trn = do
   let etim = tiEventTriggerInfoMap ti
   liftMaybe (err400 NotExists errMsg) $ M.lookup trn etim
   where
-    errMsg = "event trigger " <> trn <<> " does not exist"
+    errMsg = "event trigger " <> triggerNameToTxt trn <<> " does not exist"
 
 askQTemplateInfo
   :: (P1C m)

@@ -288,7 +288,7 @@ instance ToJSON AnnBoolExpPartialSQL where
           , toJSON (pci, map opExpSToJSON opExps)
           )
         AVRel ri relBoolExp ->
-          ( getRelTxt $ riName ri
+          ( relNameToTxt $ riName ri
           , toJSON (ri, toJSON relBoolExp)
           )
       opExpSToJSON :: OpExpG PartialSQLExp -> Value

@@ -1,7 +1,9 @@
 module Hasura.RQL.Types.Common
        ( PGColInfo(..)
        , RelName(..)
+       , relNameToTxt
        , RelType(..)
+       , rootRelName
        , relTypeToTxt
        , RelInfo(..)
 
@@ -17,6 +19,12 @@ module Hasura.RQL.Types.Common
        , ColVals
        , MutateResp(..)
        , ForeignKey(..)
+
+       , NonEmptyText
+       , mkNonEmptyText
+       , unNonEmptyText
+       , adminText
+       , rootText
        ) where
 
 import           Hasura.Prelude
@@ -25,6 +33,7 @@ import           Hasura.SQL.Types
 import           Data.Aeson
 import           Data.Aeson.Casing
 import           Data.Aeson.TH
+import           Data.Aeson.Types
 import qualified Data.HashMap.Strict        as HM
 import qualified Data.Text                  as T
 import qualified Database.PG.Query          as Q
@@ -41,15 +50,49 @@ data PGColInfo
 
 $(deriveJSON (aesonDrop 3 snakeCase) ''PGColInfo)
 
+newtype NonEmptyText = NonEmptyText {unNonEmptyText :: T.Text}
+  deriving (Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, Lift, Q.ToPrepArg, DQuote)
+
+mkNonEmptyText :: T.Text -> Maybe NonEmptyText
+mkNonEmptyText ""   = Nothing
+mkNonEmptyText text = Just $ NonEmptyText text
+
+parseNonEmptyText :: T.Text -> Parser NonEmptyText
+parseNonEmptyText text = case mkNonEmptyText text of
+  Nothing     -> fail "empty string not allowed"
+  Just neText -> return neText
+
+instance FromJSON NonEmptyText where
+  parseJSON = withText "String" parseNonEmptyText
+
+instance FromJSONKey NonEmptyText where
+  fromJSONKey = FromJSONKeyTextParser parseNonEmptyText
+
+instance Q.FromCol NonEmptyText where
+  fromCol bs = mkNonEmptyText <$> Q.fromCol bs
+    >>= maybe (Left "empty string not allowed") Right
+
+adminText :: NonEmptyText
+adminText = NonEmptyText "admin"
+
+rootText :: NonEmptyText
+rootText = NonEmptyText "root"
+
 newtype RelName
-  = RelName {getRelTxt :: T.Text}
+  = RelName {getRelTxt :: NonEmptyText}
   deriving (Show, Eq, Hashable, FromJSON, ToJSON, Q.ToPrepArg, Q.FromCol, Lift)
 
 instance IsIden RelName where
-  toIden (RelName r) = Iden r
+  toIden rn = Iden $ relNameToTxt rn
 
 instance DQuote RelName where
-  dquoteTxt (RelName r) = r
+  dquoteTxt = relNameToTxt
+
+rootRelName :: RelName
+rootRelName = RelName rootText
+
+relNameToTxt :: RelName -> T.Text
+relNameToTxt = unNonEmptyText . getRelTxt
 
 relTypeToTxt :: RelType -> T.Text
 relTypeToTxt ObjRel = "object"
@@ -101,18 +144,18 @@ fromPGCol :: PGCol -> FieldName
 fromPGCol (PGCol c) = FieldName c
 
 fromRel :: RelName -> FieldName
-fromRel (RelName r) = FieldName r
+fromRel = FieldName . relNameToTxt
 
 newtype TQueryName
-  = TQueryName { getTQueryName :: T.Text }
+  = TQueryName { getTQueryName :: NonEmptyText }
   deriving ( Show, Eq, Hashable, FromJSONKey, ToJSONKey
            , FromJSON, ToJSON, Q.ToPrepArg, Q.FromCol, Lift)
 
 instance IsIden TQueryName where
-  toIden (TQueryName r) = Iden r
+  toIden (TQueryName r) = Iden $ unNonEmptyText r
 
 instance DQuote TQueryName where
-  dquoteTxt (TQueryName r) = r
+  dquoteTxt (TQueryName r) = unNonEmptyText r
 
 newtype TemplateParam
   = TemplateParam { getTemplateParam :: T.Text }