add sql checks for select statements with group by clause (#1371)

hstream-io/hstream-io.cabal

@@ -43,11 +43,11 @@ library
   import:             shared-properties
   exposed-modules:
     HStream.IO.IOTask
+    HStream.IO.LineReader
     HStream.IO.Messages
     HStream.IO.Meta
     HStream.IO.Types
     HStream.IO.Worker
-    HStream.IO.LineReader
 
   build-depends:
     , aeson

hstream-sql/hstream-sql.cabal

@@ -68,6 +68,7 @@ library
     HStream.SQL.Codegen.V1.Boilerplate
     HStream.SQL.Codegen.V1.Transform
     HStream.SQL.Exception
+    HStream.SQL.Internal.Check
     HStream.SQL.Internal.Validate
     HStream.SQL.Parse
     HStream.SQL.Planner

hstream-sql/src/HStream/SQL/Internal/Check.hs

@@ -0,0 +1,36 @@
+module HStream.SQL.Internal.Check where
+
+import qualified Data.Map.Strict       as Map
+import           GHC.Stack             (HasCallStack)
+
+import           HStream.SQL.AST
+import           HStream.SQL.Exception (SomeSQLException (..),
+                                        buildSQLException)
+
+class Check a where
+  check :: HasCallStack => a -> Either SomeSQLException ()
+
+instance Check RSelect where
+  check (RSelect (RSel sels) _RFrom _RWhere (RGroupBy groupBys _) _RHaving) = mapM_ (checkGroupBySel groupBys) sels
+  check _ = Right ()
+
+checkGroupBySel gbs (RSelectItemProject expr _)  = checkGroupBySelExpr gbs expr
+checkGroupBySel gbs RSelectProjectQualifiedAll{} = Left $ buildSQLException ParseException Nothing "GROUP BY clause does not allow wildcards"
+checkGroupBySel gbs RSelectProjectAll            = Left $ buildSQLException ParseException Nothing "GROUP BY clause does not allow wildcards"
+
+checkGroupBySelExpr gbs (RExprCast        _ expr _RDataType)       = checkGroupBySelExpr gbs expr
+checkGroupBySelExpr gbs (RExprArray       _ exprs)                 = mapM_ (checkGroupBySelExpr gbs) exprs
+checkGroupBySelExpr gbs (RExprMap         _ eMap)                  = mapM_ (checkGroupBySelExpr gbs) (Map.keys eMap)
+checkGroupBySelExpr gbs (RExprAccessMap   _ expr _expr)            = checkGroupBySelExpr gbs expr
+checkGroupBySelExpr gbs (RExprAccessArray _ expr _RArrayAccessRhs) = checkGroupBySelExpr gbs expr
+checkGroupBySelExpr gbs (RExprCol         _ maybeStreamName name) =
+  if (maybeStreamName,name) `elem` gbs then Right () else Left $ buildSQLException ParseException Nothing "Select item does not appear in the GROUP BY clause"
+checkGroupBySelExpr gbs (RExprAggregate   _ _)                     = Right ()
+checkGroupBySelExpr gbs (RExprAccessJson  _ _JsonOp expr _expr)    = checkGroupBySelExpr gbs expr
+checkGroupBySelExpr gbs (RExprBinOp       _ _BinaryOp expr1 expr2) = checkGroupBySelExpr gbs expr1 >> checkGroupBySelExpr gbs expr2
+checkGroupBySelExpr gbs (RExprUnaryOp     _ _UnaryOp  expr)        = checkGroupBySelExpr gbs expr
+checkGroupBySelExpr gbs (RExprConst       _ _)                     = Right ()
+
+instance Check RSQL where
+  check (RQSelect rselect) = check rselect
+  check _                  = Right ()

hstream-sql/src/HStream/SQL/Parse.hs

@@ -11,6 +11,7 @@ import           HStream.SQL.Abs               (SQL)
 import           HStream.SQL.AST               (RSQL, Refine (refine))
 import           HStream.SQL.Exception         (SomeSQLException (..),
                                                 throwSQLException)
+import           HStream.SQL.Internal.Check    (Check (check))
 import           HStream.SQL.Internal.Validate (Validate (validate))
 import           HStream.SQL.Lex               (tokens)
 import           HStream.SQL.Par               (pSQL)
@@ -28,4 +29,6 @@ parse input = do
         Right vsql     -> return vsql
 
 parseAndRefine :: HasCallStack => Text -> IO RSQL
-parseAndRefine input = parse input <&> refine
+parseAndRefine input = do
+  rsql <- parse input <&> refine
+  case check rsql of Left e -> throw e; Right _ -> return rsql