hasura · shahidhk · Oct 12, 2018 · Oct 11, 2018 · Oct 11, 2018 · Oct 11, 2018
@@ -206,6 +206,7 @@ library
                      , Hasura.SQL.Value
                      , Hasura.SQL.GeoJSON
                      , Hasura.SQL.Time
+                     , Hasura.SQL.Rewrite
                      , Hasura.Prelude
                      , Hasura.Logging
                      , Ops

@@ -22,6 +22,7 @@ import           Hasura.Prelude
 import           Hasura.RQL.DML.Internal
 import           Hasura.RQL.GBoolExp
 import           Hasura.RQL.Types
+import           Hasura.SQL.Rewrite         (prefixNumToAliases)
 import           Hasura.SQL.Types
 
 import qualified Database.PG.Query          as Q
@@ -134,10 +135,23 @@ mkBaseTableAls :: Iden -> Iden
 mkBaseTableAls pfx =
   pfx <> Iden ".base"
 
-mkSelExtr
+-- posttgres ignores anything beyond 63 chars for an iden
+-- in this case, we'll need to use json_build_object function
+-- json_build_object is slower than row_to_json hence it is only
+-- used when needed
+buildJsonObject
   :: Iden -> FieldName
   -> [(FieldName, AnnFld)] -> (S.Alias, S.SQLExp)
-mkSelExtr pfx parAls flds =
+buildJsonObject pfx parAls flds =
+  if any ( (> 63) . T.length . getFieldNameTxt . fst ) flds
+  then withJsonBuildObj pfx parAls flds
+  else withRowToJSON pfx parAls flds
+
+-- uses row_to_json to build a json object
+withRowToJSON
+  :: Iden -> FieldName
+  -> [(FieldName, AnnFld)] -> (S.Alias, S.SQLExp)
+withRowToJSON pfx parAls flds =
   (S.toAlias parAls, jsonRow)
   where
     withAls fldName sqlExp =
@@ -153,6 +167,28 @@ mkSelExtr pfx parAls flds =
               ArrRel -> mkArrRelTableAls pfx parAls fldAls
         in S.mkQIdenExp qual fldAls
 
+-- uses json_build_object to build a json object
+withJsonBuildObj
+  :: Iden -> FieldName
+  -> [(FieldName, AnnFld)] -> (S.Alias, S.SQLExp)
+withJsonBuildObj pfx parAls flds =
+  (S.toAlias parAls, jsonRow)
+  where
+    withAls fldName sqlExp =
+      [S.SELit $ getFieldNameTxt fldName, sqlExp]
+
+    jsonRow = S.SEFnApp "json_build_object" (concatMap toFldExtr flds) Nothing
+
+    toFldExtr (fldAls, fld) = withAls fldAls $ case fld of
+      FCol col    -> toJSONableExp (pgiType col) $
+                     S.mkQIdenExp (mkBaseTableAls pfx) $ pgiName col
+      FExp e      -> S.SELit e
+      FRel annRel ->
+        let qual = case arType annRel of
+              ObjRel -> mkObjRelTableAls pfx $ arName annRel
+              ArrRel -> mkArrRelTableAls pfx parAls fldAls
+        in S.mkQIdenExp qual fldAls
+
 processAnnOrderByItem
   :: Iden
   -> AnnOrderByItem
@@ -220,7 +256,7 @@ mkBaseNode pfx fldAls (AnnSel flds tn fromItemM fltr permLimitM tableArgs) =
     fromItem = fromMaybe (S.FISimple tn Nothing) fromItemM
 
     -- the selection extractor
-    selExtr  = mkSelExtr pfx fldAls flds
+    selExtr  = buildJsonObject pfx fldAls flds
 
     -- all the relationships
     (allObjs, allArrs) =
@@ -611,14 +647,16 @@ getSelectDeps (AnnSel flds tn _ _ _ tableArgs) =
 
 mkSQLSelect :: Bool -> AnnSel -> S.Select
 mkSQLSelect isSingleObject annSel =
+  prefixNumToAliases $
   if isSingleObject
-  then asSingleRow rootAls rootSelAsSubQuery
-  else withJsonAgg Nothing rootAls rootSelAsSubQuery
+  then asSingleRow rootFldAls rootSelAsSubQuery
+  else withJsonAgg Nothing rootFldAls rootSelAsSubQuery
   where
-    rootSelAsSubQuery = S.mkSelFromItem rootSel rootAls
-    rootAls  = S.Alias $ Iden "root"
+    rootSelAsSubQuery = S.mkSelFromItem rootSel $ S.Alias $ Iden "root_alias"
     rootSel  = baseNodeToSel (S.BELit True) rootNode
-    rootNode = mkBaseNode (Iden "root") (FieldName "root") annSel
+    rootFldName = FieldName "root"
+    rootFldAls  = S.Alias $ toIden rootFldName
+    rootNode = mkBaseNode (Iden "root") rootFldName annSel
 
 asSingleRow :: S.Alias -> S.FromItem -> S.Select
 asSingleRow col fromItem =

@@ -132,7 +132,7 @@ mkRowExp extrs = let
 
   -- SELECT r FROM (SELECT col1, col2, .. ) AS r
   outerSel = mkSelect
-             { selExtr = [mkExtr innerSelName]
+             { selExtr = [Extractor (SERowIden $ toIden innerSelName) Nothing]
              , selFrom = Just $ FromExp
                          [mkSelFromExp False innerSel innerSelName]
              }
@@ -245,6 +245,8 @@ data SQLExp
   | SESelect !Select
   | SEStar
   | SEIden !Iden
+  -- iden and row identifier are distinguished for easier rewrite rules
+  | SERowIden !Iden
   | SEQIden !QIden
   | SEFnApp !T.Text ![SQLExp] !(Maybe OrderByExp)
   | SEOpApp !SQLOp ![SQLExp]
@@ -281,6 +283,8 @@ instance ToSQL SQLExp where
     BB.char7 '*'
   toSQL (SEIden iden) =
     toSQL iden
+  toSQL (SERowIden iden) =
+    toSQL iden
   toSQL (SEQIden qIden) =
     toSQL qIden
   -- https://www.postgresql.org/docs/10/static/sql-expressions.html#SYNTAX-AGGREGATES
@@ -337,9 +341,10 @@ instance ToSQL Extractor where
   toSQL (Extractor ce mal) =
     toSQL ce <-> toSQL mal
 
-data DistinctExpr = DistinctSimple
-                  | DistinctOn ![SQLExp]
-                  deriving (Show, Eq)
+data DistinctExpr
+  = DistinctSimple
+  | DistinctOn ![SQLExp]
+  deriving (Show, Eq)
 
 instance ToSQL DistinctExpr where
   toSQL DistinctSimple    = BB.string7 "DISTINCT"
@@ -377,11 +382,12 @@ instance ToSQL Lateral where
   toSQL (Lateral False) = mempty
 
 data JoinExpr
-  = JoinExpr { tjeLeft  :: !FromItem
-             , tjeType  :: !JoinType
-             , tjeRight :: !FromItem
-             , tjeJC    :: !JoinCond
-             } deriving (Show, Eq)
+  = JoinExpr
+  { tjeLeft  :: !FromItem
+  , tjeType  :: !JoinType
+  , tjeRight :: !FromItem
+  , tjeJC    :: !JoinCond
+  } deriving (Show, Eq)
 
 instance ToSQL JoinExpr where
   toSQL je =
@@ -390,36 +396,39 @@ instance ToSQL JoinExpr where
     <-> toSQL (tjeRight je)
     <-> toSQL (tjeJC je)
 
-data JoinType = Inner
-              | LeftOuter
-              | RightOuter
-              | FullOuter
-              deriving (Eq, Show)
+data JoinType
+  = Inner
+  | LeftOuter
+  | RightOuter
+  | FullOuter
+  deriving (Eq, Show)
 
 instance ToSQL JoinType where
   toSQL Inner      = BB.string7 "INNER JOIN"
   toSQL LeftOuter  = BB.string7 "LEFT OUTER JOIN"
   toSQL RightOuter = BB.string7 "RIGHT OUTER JOIN"
   toSQL FullOuter  = BB.string7 "FULL OUTER JOIN"
 
-data JoinCond = JoinOn !BoolExp
-              | JoinUsing ![PGCol]
-              deriving (Show, Eq)
+data JoinCond
+  = JoinOn !BoolExp
+  | JoinUsing ![PGCol]
+  deriving (Show, Eq)
 
 instance ToSQL JoinCond where
   toSQL (JoinOn be) =
     BB.string7 "ON" <-> paren (toSQL be)
   toSQL (JoinUsing cols) =
     BB.string7 "USING" <-> paren (","  <+> cols)
 
-data BoolExp = BELit !Bool
-             | BEBin !BinOp !BoolExp !BoolExp
-             | BENot !BoolExp
-             | BECompare !CompareOp !SQLExp !SQLExp
-             | BENull !SQLExp
-             | BENotNull !SQLExp
-             | BEExists !Select
-             deriving (Show, Eq)
+data BoolExp
+  = BELit !Bool
+  | BEBin !BinOp !BoolExp !BoolExp
+  | BENot !BoolExp
+  | BECompare !CompareOp !SQLExp !SQLExp
+  | BENull !SQLExp
+  | BENotNull !SQLExp
+  | BEExists !Select
+  deriving (Show, Eq)
 
 -- removes extraneous 'AND true's
 simplifyBoolExp :: BoolExp -> BoolExp

@@ -0,0 +1,178 @@
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE MultiWayIf        #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hasura.SQL.Rewrite
+  ( prefixNumToAliases
+  ) where
+
+import qualified Data.HashMap.Strict as Map
+import qualified Data.Text           as T
+import           Hasura.Prelude
+import qualified Hasura.SQL.DML      as S
+import           Hasura.SQL.Types    (Iden (..))
+
+
+-- add an int as a prefix to all aliases.
+-- This is needed in cases identifiers exceed 63 chars
+-- as postgres only considers first 63 chars of
+-- an identifier
+prefixNumToAliases :: S.Select -> S.Select
+prefixNumToAliases s =
+  uSelect s `evalState` UniqSt 0 Map.empty
+
+type Rewrite a = State a
+
+data UniqSt
+  = UniqSt
+  { _uqVar   :: !Int
+  , _uqIdens :: !(Map.HashMap Iden Int)
+  } deriving (Show, Eq)
+
+type Uniq = Rewrite UniqSt
+
+withNumPfx :: Iden -> Int -> Iden
+withNumPfx iden i =
+  Iden pfx <> iden
+  where
+    pfx = T.pack $ "_" <> show i <> "_"
+
+addAlias :: S.Alias -> Uniq S.Alias
+addAlias (S.Alias iden) = do
+  UniqSt var idens <- get
+  put $ UniqSt (var + 1) $ Map.insert iden var idens
+  return $ S.Alias $ withNumPfx iden var
+
+getIden :: Iden -> Uniq Iden
+getIden iden = do
+  UniqSt _ idens <- get
+  let varNumM = Map.lookup iden idens
+  return $ maybe iden (withNumPfx iden) varNumM
+
+restoringIdens :: Uniq a -> Uniq a
+restoringIdens action = do
+  UniqSt _ idens <- get
+  res <- action
+  -- restore the idens to before the action
+  modify' $ \s -> s { _uqIdens = idens }
+  return res
+
+uSelect :: S.Select -> Uniq S.Select
+uSelect sel = do
+  -- this has to be the first thing to process
+  newFromM  <- mapM uFromExp fromM
+
+  newWhereM <- forM whereM $
+               \(S.WhereFrag be) -> S.WhereFrag <$> uBoolExp be
+  newGrpM   <- forM grpM $
+               \(S.GroupByExp l) -> S.GroupByExp <$> mapM uSqlExp l
+  newHavnM  <- forM havnM $
+               \(S.HavingExp be) -> S.HavingExp <$> uBoolExp be
+  newOrdM   <- mapM uOrderBy ordByM
+  newDistM  <- mapM uDistinct distM
+  newExtrs  <- mapM uExtractor extrs
+  return $ S.Select newDistM newExtrs newFromM newWhereM newGrpM
+    newHavnM newOrdM limitM offM
+  where
+    S.Select distM extrs fromM whereM grpM havnM ordByM limitM offM = sel
+    uDistinct = \case
+      S.DistinctSimple -> return S.DistinctSimple
+      S.DistinctOn l   -> S.DistinctOn <$> mapM uSqlExp l
+    uExtractor (S.Extractor e alM) =
+      S.Extractor <$> uSqlExp e <*> return alM
+
+uFromExp :: S.FromExp -> Uniq S.FromExp
+uFromExp (S.FromExp fromItems) =
+  S.FromExp <$> mapM uFromItem fromItems
+
+uFromItem :: S.FromItem -> Uniq S.FromItem
+uFromItem fromItem = case fromItem of
+  S.FISimple t alM ->
+    S.FISimple t <$> mapM addAlias alM
+  S.FIIden iden ->
+    S.FIIden <$> return iden
+  S.FISelect isLateral sel al -> do
+    -- we are kind of ignoring if we have to reset
+    -- idens to empty based on correlation
+    -- unless isLateral $ modify' $ \s -> s { _uqIdens = Map.empty}
+    newSel <- restoringIdens $ uSelect sel
+    newAls <- addAlias al
+    return $ S.FISelect isLateral newSel newAls
+  S.FIJoin joinExp ->
+    S.FIJoin <$> uJoinExp joinExp
+
+uJoinExp :: S.JoinExpr -> Uniq S.JoinExpr
+uJoinExp (S.JoinExpr left ty right joinCond) = do
+  leftN  <- uFromItem left
+  rightN <- uFromItem right
+  S.JoinExpr leftN ty rightN <$> uJoinCond joinCond
+
+uJoinCond :: S.JoinCond -> Uniq S.JoinCond
+uJoinCond joinCond = case joinCond of
+  S.JoinOn be      -> S.JoinOn <$> uBoolExp be
+  S.JoinUsing cols -> return $ S.JoinUsing cols
+
+uBoolExp :: S.BoolExp -> Uniq S.BoolExp
+uBoolExp = restoringIdens . \case
+  S.BELit b -> return $ S.BELit b
+  S.BEBin op left right ->
+    S.BEBin <$> return op <*> uBoolExp left <*> uBoolExp right
+  S.BENot b -> S.BENot <$> uBoolExp b
+  S.BECompare op left right ->
+    S.BECompare <$> return op <*> uSqlExp left <*> uSqlExp right
+  S.BENull e -> S.BENull <$> uSqlExp e
+  S.BENotNull e -> S.BENotNull <$> uSqlExp e
+  S.BEExists sel -> S.BEExists <$> uSelect sel
+
+uOrderBy :: S.OrderByExp -> Uniq S.OrderByExp
+uOrderBy (S.OrderByExp ordByItems) =
+  S.OrderByExp <$> mapM uOrderByItem ordByItems
+  where
+    uOrderByItem (S.OrderByItem e ordTyM nullsOrdM) =
+      S.OrderByItem
+      <$> uSqlExp e
+      <*> return ordTyM
+      <*> return nullsOrdM
+
+uSqlExp :: S.SQLExp -> Uniq S.SQLExp
+uSqlExp = restoringIdens . \case
+  S.SEPrep i                    -> return $ S.SEPrep i
+  S.SELit t                     -> return $ S.SELit t
+  S.SEUnsafe t                  -> return $ S.SEUnsafe t
+  S.SESelect s                  -> S.SESelect <$> uSelect s
+  S.SEStar                      -> return S.SEStar
+  -- this is for row expressions
+  -- todo: check if this is always okay
+  S.SEIden iden                 -> return $ S.SEIden iden
+  S.SERowIden iden              -> S.SERowIden <$> getIden iden
+  S.SEQIden (S.QIden qual iden) -> do
+    newQual <- uQual qual
+    return $ S.SEQIden $ S.QIden newQual iden
+  S.SEFnApp fn args ordByM      ->
+    S.SEFnApp
+    <$> return fn
+    <*> mapM uSqlExp args
+    <*> mapM uOrderBy ordByM
+  S.SEOpApp op args             ->
+    S.SEOpApp op
+    <$> mapM uSqlExp args
+  S.SETyAnn e ty                ->
+    S.SETyAnn
+    <$> uSqlExp e
+    <*> return ty
+  S.SECond be onTrue onFalse    ->
+    S.SECond
+    <$> uBoolExp be
+    <*> uSqlExp onTrue
+    <*> uSqlExp onFalse
+  S.SEBool be                   ->
+    S.SEBool <$> uBoolExp be
+  S.SEExcluded t                ->
+    S.SEExcluded <$> return t
+  S.SEArray l                   ->
+    S.SEArray <$> mapM uSqlExp l
+  where
+    uQual = \case
+      S.QualIden iden -> S.QualIden <$> getIden iden
+      S.QualTable t   -> return $ S.QualTable t
+      S.QualVar t     -> return $ S.QualVar t