server: fix mishandling of GeoJSON inputs in subscriptions (fix hasur…

…a#3239) (hasura#4551)

* Add support for multiple top-level fields in a subscription to improve testability of subscriptions

* Add an internal flag to enable multiple subscriptions

* Add missing call to withConstructorFn in live queries (fix hasura#3239)

Co-authored-by: Alexis King <lexi.lambda@gmail.com>

server/commit_diff.txt

@@ -346,17 +346,3 @@ Date:   Wed May 13 18:03:16 2020 +0530
     Co-authored-by: Marion Schleifer <marion@hasura.io>
     Co-authored-by: Karthikeyan Chinnakonda <karthikeyan@hasura.io>
     Co-authored-by: Aleksandra Sikora <ola.zxcvbnm@gmail.com>
-
-commit 4d10a610f4ade66db758d459e3ddf02a43996e45
-Author: Auke Booij <auke@hasura.io>
-Date:   Wed May 13 10:09:44 2020 +0200
-
-    server: fix mishandling of GeoJSON inputs in subscriptions (fix #3239) (#4551)
-
-    * Add support for multiple top-level fields in a subscription to improve testability of subscriptions
-
-    * Add an internal flag to enable multiple subscriptions
-
-    * Add missing call to withConstructorFn in live queries (fix #3239)
-
-    Co-authored-by: Alexis King <lexi.lambda@gmail.com>

server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Plan.hs

@@ -62,6 +62,7 @@ import           Hasura.Session
 import           Hasura.SQL.Error
 import           Hasura.SQL.Types
 import           Hasura.SQL.Value
+import           Hasura.Server.Version             (HasVersion)
 
 -- -------------------------------------------------------------------------------------------------
 -- Multiplexed queries
@@ -332,7 +333,7 @@ buildLiveQueryPlan pgExecCtx userInfo unpreparedAST = do
       cohortVariables = CohortVariables (_uiSession userInfo) validatedQueryVars validatedSyntheticVars
 
       plan = LiveQueryPlan parameterizedPlan cohortVariables
-      -- varTypes = finalReusability ^? GV._Reusable
+      -- varTypes = finalReusability ^? GV._Reusable -- TODO(PDV): Depends on query plan caching
       reusablePlan = ReusableLiveQueryPlan parameterizedPlan validatedSyntheticVars <$> _varTypes
   pure (plan, reusablePlan)
 

server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Poll.hs

@@ -44,6 +44,7 @@ import qualified Data.Time.Clock                          as Clock
 import qualified Data.UUID                                as UUID
 import qualified Data.UUID.V4                             as UUID
 --import qualified Language.GraphQL.Draft.Syntax            as G
+
 import qualified ListT
 import qualified StmContainers.Map                        as STMMap
 import qualified System.Metrics.Distribution              as Metrics
@@ -63,12 +64,7 @@ import           Hasura.Session
 -- -------------------------------------------------------------------------------------------------
 -- Subscribers
 
-data Subscriber
-  = Subscriber
-  { --  _sRootAlias        :: !G.Name
-  -- ,
-    _sOnChangeCallback :: !OnChange
-  }
+newtype Subscriber = Subscriber { _sOnChangeCallback :: OnChange }
 
 -- | live query onChange metadata, used for adding more extra analytics data
 data LiveQueryMetadata
@@ -84,7 +80,6 @@ data LiveQueryResponse
   }
 
 type LGQResponse = GQResult LiveQueryResponse
-
 type OnChange = LGQResponse -> IO ()
 
 newtype SubscriberId = SubscriberId { _unSinkId :: UUID.UUID }
@@ -201,13 +196,8 @@ pushResultToCohort result !respHashM (LiveQueryMetadata dTime) cohortSnapshot =
   pushResultToSubscribers sinks
   where
     CohortSnapshot _ respRef curSinks newSinks = cohortSnapshot
-    pushResultToSubscribers = A.mapConcurrently_ $ \(Subscriber action) ->
-      let -- aliasText = G.unName alias
-          wrapWithAlias response = LiveQueryResponse
-            { _lqrPayload = encJToBS response
-            , _lqrExecutionTime = dTime
-            }
-      in action (wrapWithAlias <$> result)
+    response = result <&> \payload -> LiveQueryResponse (encJToBS payload) dTime
+    pushResultToSubscribers = A.mapConcurrently_ $ \(Subscriber action) -> action response
 
 -- -------------------------------------------------------------------------------------------------
 -- Pollers

server/src-lib/Hasura/GraphQL/Execute/LiveQuery/State.hs

@@ -111,8 +111,7 @@ addLiveQuery logger lqState plan onResultAction = do
 
     handlerId = PollerKey role query
 
-    !subscriber = -- Subscriber alias onResultAction
-      Subscriber onResultAction
+    !subscriber = Subscriber onResultAction
     addToCohort sinkId handlerC =
       TMap.insert (Subscriber onResultAction) sinkId $ _cNewSubscribers handlerC
 

server/src-lib/Hasura/GraphQL/Validate.hs

@@ -29,6 +29,7 @@ import qualified Data.Text                              as T
 import qualified Data.UUID                              as UUID
 import qualified Database.PG.Query                      as Q
 import qualified Language.GraphQL.Draft.Syntax          as G
+import qualified Data.Sequence                          as Seq
 
 import           Hasura.GraphQL.NormalForm
 import           Hasura.GraphQL.Resolve.InputValue      (annInpValueToJson)
@@ -69,8 +70,7 @@ getTypedOp opNameM selSets opDefs =
       throwVE $ "operationName cannot be used when " <>
       "an anonymous operation exists in the document"
     (Nothing, [selSet], []) ->
-      return $ G.TypedOperationDefinition
-      G.OperationTypeQuery Nothing [] [] selSet
+      return $ G.TypedOperationDefinition G.OperationTypeQuery Nothing [] [] selSet
     (Nothing, [], [opDef])  ->
       return opDef
     (Nothing, _, _) ->

server/src-lib/Hasura/GraphQL/Validate/Types.hs

@@ -788,6 +788,9 @@ class (Monad m) => MonadReusability m where
 instance (MonadReusability m) => MonadReusability (ReaderT r m) where
   recordVariableUse a b = lift $ recordVariableUse a b
   markNotReusable = lift markNotReusable
+instance (MonadReusability m) => MonadReusability (StateT s m) where
+  recordVariableUse a b = lift $ recordVariableUse a b
+  markNotReusable = lift markNotReusable
 
 instance (MonadReusability m) => MonadReusability (StateT s m) where
   recordVariableUse a b = lift $ recordVariableUse a b

server/src-lib/Hasura/SQL/DML.hs

@@ -23,7 +23,10 @@ paren t = TB.char '(' <> t <> TB.char ')'
 
 data Select
   = Select
-    { selDistinct :: !(Maybe DistinctExpr)
+    { selCTEs     :: ![(Alias, Select)]
+    -- ^ Unlike 'SelectWith', does not allow data-modifying statements (as those are only allowed at
+    -- the top level of a query).
+    , selDistinct :: !(Maybe DistinctExpr)
     , selExtr     :: ![Extractor]
     , selFrom     :: !(Maybe FromExp)
     , selWhere    :: !(Maybe WhereFrag)
@@ -38,7 +41,7 @@ instance Cacheable Select
 instance Hashable Select
 
 mkSelect :: Select
-mkSelect = Select Nothing [] Nothing
+mkSelect = Select [] Nothing [] Nothing
            Nothing Nothing Nothing
            Nothing Nothing Nothing
 
@@ -167,17 +170,20 @@ instance ToSQL WhereFrag where
     "WHERE" <-> paren (toSQL be)
 
 instance ToSQL Select where
-  toSQL sel =
-    "SELECT"
-    <-> toSQL (selDistinct sel)
-    <-> (", " <+> selExtr sel)
-    <-> toSQL (selFrom sel)
-    <-> toSQL (selWhere sel)
-    <-> toSQL (selGroupBy sel)
-    <-> toSQL (selHaving sel)
-    <-> toSQL (selOrderBy sel)
-    <-> toSQL (selLimit sel)
-    <-> toSQL (selOffset sel)
+  toSQL sel = case selCTEs sel of
+    [] -> "SELECT"
+      <-> toSQL (selDistinct sel)
+      <-> (", " <+> selExtr sel)
+      <-> toSQL (selFrom sel)
+      <-> toSQL (selWhere sel)
+      <-> toSQL (selGroupBy sel)
+      <-> toSQL (selHaving sel)
+      <-> toSQL (selOrderBy sel)
+      <-> toSQL (selLimit sel)
+      <-> toSQL (selOffset sel)
+    -- reuse SelectWith if there are any CTEs, since the generated SQL is the same
+    ctes -> toSQL $ SelectWith (map (CTESelect <$>) ctes) sel { selCTEs = [] }
+
 
 mkSIdenExp :: (IsIden a) => a -> SQLExp
 mkSIdenExp = SEIden . toIden

server/src-lib/Hasura/SQL/Rewrite.hs

@@ -72,6 +72,7 @@ uSelect :: S.Select -> Uniq S.Select
 uSelect sel = do
   -- this has to be the first thing to process
   newFromM  <- mapM uFromExp fromM
+  newCTEs <- for ctes $ \(alias, cte) -> (,) <$> addAlias alias <*> uSelect cte
 
   newWhereM <- forM whereM $
                \(S.WhereFrag be) -> S.WhereFrag <$> uBoolExp be
@@ -82,10 +83,10 @@ uSelect sel = do
   newOrdM   <- mapM uOrderBy ordByM
   newDistM  <- mapM uDistinct distM
   newExtrs  <- mapM uExtractor extrs
-  return $ S.Select newDistM newExtrs newFromM newWhereM newGrpM
+  return $ S.Select newCTEs newDistM newExtrs newFromM newWhereM newGrpM
     newHavnM newOrdM limitM offM
   where
-    S.Select distM extrs fromM whereM grpM havnM ordByM limitM offM = sel
+    S.Select ctes 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