server: fix BigQuery's hack for explain.

GitOrigin-RevId: 6668e16dee1a6bb0b666cfe0b4727f2c4f3181fb

server/src-lib/Hasura/Backends/BigQuery/Instances/Execute.hs

@@ -3,45 +3,47 @@
 module Hasura.Backends.BigQuery.Instances.Execute () where
 
 import qualified Data.Aeson                                  as Aeson
-import qualified Data.HashMap.Strict.InsOrd                  as OMap
-import qualified Hasura.Backends.BigQuery.DataLoader.Execute as DataLoader
-import qualified Hasura.Backends.BigQuery.DataLoader.Plan    as DataLoader
-import           Hasura.EncJSON
-import           Hasura.Prelude
-import qualified Hasura.RQL.Types.Error                      as RQL
-import qualified Hasura.SQL.AnyBackend                       as AB
-
 import qualified Data.Environment                            as Env
+import qualified Data.HashMap.Strict.InsOrd                  as OMap
+import qualified Data.Text                                   as T
 import qualified Language.GraphQL.Draft.Syntax               as G
 import qualified Network.HTTP.Client                         as HTTP
 import qualified Network.HTTP.Types                          as HTTP
 
+import qualified Hasura.Backends.BigQuery.DataLoader.Execute as DataLoader
+import qualified Hasura.Backends.BigQuery.DataLoader.Plan    as DataLoader
+import qualified Hasura.RQL.Types.Error                      as RQL
+import qualified Hasura.SQL.AnyBackend                       as AB
 import qualified Hasura.Tracing                              as Tracing
 
 import           Hasura.Backends.BigQuery.Plan
+import           Hasura.EncJSON
 import           Hasura.GraphQL.Context
 import           Hasura.GraphQL.Execute.Backend
 import           Hasura.GraphQL.Parser
+import           Hasura.Prelude
 import           Hasura.RQL.Types
 import           Hasura.Session
 
--- MultiplexedQuery
+
 instance BackendExecute 'BigQuery where
-  type PreparedQuery  'BigQuery = Text
+  type PreparedQuery    'BigQuery = Text
-  type ExecutionMonad 'BigQuery = Tracing.TraceT (ExceptT QErr IO)
   type MultiplexedQuery 'BigQuery = Void
+  type ExecutionMonad   'BigQuery = Tracing.TraceT (ExceptT QErr IO)
   getRemoteJoins = const []
 
-  mkDBQueryPlan = msDBQueryPlan
+  mkDBQueryPlan = bqDBQueryPlan
-  mkDBMutationPlan = msDBMutationPlan
+  mkDBMutationPlan = bqDBMutationPlan
   mkDBSubscriptionPlan _ _ _ _ =
     throwError $ RQL.internalError "Cannot currently perform subscriptions on BigQuery sources."
-  mkDBQueryExplain _ _ _ _ _ = throwError $ RQL.internalError "Cannot currently retrieve query execution plans on BigQuery sources."
+  mkDBQueryExplain = bqDBQueryExplain
-  mkLiveQueryExplain _ = throwError $ RQL.internalError "Cannot currently retrieve query execution plans on BigQuery sources."
+  mkLiveQueryExplain _ =
+    throwError $ RQL.internalError "Cannot currently retrieve query execution plans on BigQuery sources."
+
 
 -- query
 
-msDBQueryPlan
+bqDBQueryPlan
   :: forall m.
      ( MonadError QErr m
      )
@@ -54,7 +56,7 @@ msDBQueryPlan
   -> SourceConfig 'BigQuery
   -> QueryDB 'BigQuery (UnpreparedValue 'BigQuery)
   -> m ExecutionStep
-msDBQueryPlan _env _manager _reqHeaders userInfo _directives sourceName sourceConfig qrf = do
+bqDBQueryPlan _env _manager _reqHeaders userInfo _directives sourceName sourceConfig qrf = do
   select <- planNoPlan userInfo qrf
   let (!headAndTail, !plannedActionsList) =
         DataLoader.runPlan
@@ -103,9 +105,10 @@ recordSetToEncJSON DataLoader.RecordSet {rows} =
         -- a record in it.
         DataLoader.RecordOutputValue !record -> encJFromRecord record
 
+
 -- mutation
 
-msDBMutationPlan
+bqDBMutationPlan
   :: forall m.
      ( MonadError QErr m
      )
@@ -118,5 +121,28 @@ msDBMutationPlan
   -> SourceConfig 'BigQuery
   -> MutationDB 'BigQuery (UnpreparedValue 'BigQuery)
   -> m ExecutionStep
-msDBMutationPlan _env _manager _reqHeaders _userInfo _stringifyNum _sourceName _sourceConfig _mrf =
+bqDBMutationPlan _env _manager _reqHeaders _userInfo _stringifyNum _sourceName _sourceConfig _mrf =
   throw500 "mutations are not supported in BigQuery; this should be unreachable"
+
+
+-- explain
+
+bqDBQueryExplain
+  :: MonadError QErr m
+  => G.Name
+  -> UserInfo
+  -> SourceName
+  -> SourceConfig 'BigQuery
+  -> QueryDB 'BigQuery (UnpreparedValue 'BigQuery)
+  -> m (AB.AnyBackend DBStepInfo)
+bqDBQueryExplain fieldName userInfo sourceName sourceConfig qrf = do
+  actionsForest <- planToForest userInfo qrf
+  pure
+    $ AB.mkAnyBackend
+    $ DBStepInfo @'BigQuery sourceName sourceConfig Nothing
+    $ pure
+    $ encJFromJValue
+    $ ExplainPlan
+        fieldName
+        (Just ("--\n" <> DataLoader.drawActionsForestSQL actionsForest))
+        (Just ("": T.lines (DataLoader.drawActionsForest actionsForest)))

server/src-lib/Hasura/Backends/BigQuery/Instances/Transport.hs

@@ -2,31 +2,36 @@
 
 module Hasura.Backends.BigQuery.Instances.Transport () where
 
+import           Hasura.Prelude
+
 import qualified Data.Aeson                                 as J
+import qualified Language.GraphQL.Draft.Syntax              as G
+
+import qualified Hasura.Logging                             as L
+import qualified Hasura.Tracing                             as Tracing
+
 import           Hasura.Backends.BigQuery.Instances.Execute ()
 import           Hasura.Backends.MSSQL.Instances.Execute    ()
 import           Hasura.EncJSON
+import           Hasura.GraphQL.Execute.Backend
 import           Hasura.GraphQL.Logging                     (GeneratedQuery (..),
                                                              MonadQueryLog (..), QueryLog (..),
                                                              QueryLogKind (QueryLogKindDatabase))
 import           Hasura.GraphQL.Transport.Backend
 import           Hasura.GraphQL.Transport.HTTP.Protocol
-import qualified Hasura.Logging                             as L
-
-import           Hasura.Prelude
 import           Hasura.RQL.Types
 import           Hasura.Server.Types                        (RequestId)
 import           Hasura.Session
 import           Hasura.Tracing
-import qualified Hasura.Tracing                             as Tracing
+
-import qualified Language.GraphQL.Draft.Syntax              as G
 
 instance BackendTransport 'BigQuery  where
   runDBQuery = runQuery
-  runDBQueryExplain = error "Not supported."
+  runDBQueryExplain = runQueryExplain
   runDBMutation = runMutation
   runDBSubscription = error "Not supported."
 
+
 runQuery
   :: ( MonadIO m
      , MonadQueryLog m
@@ -47,13 +52,15 @@ runQuery reqId query fieldName _userInfo logger _sourceConfig tx genSql = do
   -- log the generated SQL and the graphql query
   -- FIXME: fix logging by making logQueryLog expect something backend agnostic!
   logQueryLog logger $ mkQueryLog query fieldName genSql reqId
-  withElapsedTime $
+  withElapsedTime $ Tracing.interpTraceT run tx
-    flip Tracing.interpTraceT tx $ \m -> run m
 
-run :: (MonadIO m, MonadError QErr m) => ExceptT QErr IO a -> m a
+runQueryExplain
-run action = do
+  :: ( MonadIO m
-  result <- liftIO $ runExceptT action
+     , MonadError QErr m
-  result `onLeft` throwError
+     )
+  => DBStepInfo 'BigQuery
+  -> m EncJSON
+runQueryExplain (DBStepInfo _ _ _ action) = run $ runTraceTWithReporter noReporter "explain" action
 
 runMutation
   :: ( MonadError QErr m
@@ -73,6 +80,11 @@ runMutation _reqId _query _fieldName _userInfo _logger _sourceConfig _tx _genSql
   throw500 "BigQuery does not support mutations!"
 
 
+run :: (MonadIO m, MonadError QErr m) => ExceptT QErr IO a -> m a
+run action = do
+  result <- liftIO $ runExceptT action
+  result `onLeft` throwError
+
 mkQueryLog
   :: GQLReqUnparsed
   -> G.Name

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

@@ -5,31 +5,28 @@ module Hasura.GraphQL.Explain
 
 import           Hasura.Prelude
 
-import qualified Data.Aeson                               as J
+import qualified Data.Aeson                             as J
-import qualified Data.Aeson.TH                            as J
+import qualified Data.Aeson.TH                          as J
-import qualified Data.HashMap.Strict                      as Map
+import qualified Data.HashMap.Strict                    as Map
-import qualified Data.HashMap.Strict.InsOrd               as OMap
+import qualified Data.HashMap.Strict.InsOrd             as OMap
-import qualified Language.GraphQL.Draft.Syntax            as G
+import qualified Language.GraphQL.Draft.Syntax          as G
 
-import           Control.Monad.Trans.Control              (MonadBaseControl)
+import           Control.Monad.Trans.Control            (MonadBaseControl)
-import qualified Data.Text                                as T
 
-import qualified Hasura.Backends.BigQuery.DataLoader.Plan as BigQuery
+import qualified Hasura.GraphQL.Execute                 as E
-import qualified Hasura.Backends.BigQuery.Plan            as BigQuery
+import qualified Hasura.GraphQL.Execute.Action          as E
-import qualified Hasura.GraphQL.Execute                   as E
+import qualified Hasura.GraphQL.Execute.Inline          as E
-import qualified Hasura.GraphQL.Execute.Action            as E
+import qualified Hasura.GraphQL.Execute.Query           as E
-import qualified Hasura.GraphQL.Execute.Inline            as E
+import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
-import qualified Hasura.GraphQL.Execute.Query             as E
+import qualified Hasura.SQL.AnyBackend                  as AB
-import qualified Hasura.GraphQL.Transport.HTTP.Protocol   as GH
-import qualified Hasura.SQL.AnyBackend                    as AB
 
 import           Hasura.EncJSON
 import           Hasura.GraphQL.Context
 import           Hasura.GraphQL.Execute.Backend
-import           Hasura.GraphQL.Execute.Instances         ()
+import           Hasura.GraphQL.Execute.Instances       ()
 import           Hasura.GraphQL.Parser
 import           Hasura.GraphQL.Transport.Backend
-import           Hasura.GraphQL.Transport.Instances       ()
+import           Hasura.GraphQL.Transport.Instances     ()
 import           Hasura.Metadata.Class
 import           Hasura.RQL.Types
 import           Hasura.Session
@@ -55,34 +52,18 @@ explainQueryField
   => UserInfo
   -> G.Name
   -> QueryRootField UnpreparedValue
-  -> m (Maybe EncJSON)
+  -> m EncJSON
 explainQueryField userInfo fieldName rootField = do
   case rootField of
     RFRemote _ -> throw400 InvalidParams "only hasura queries can be explained"
     RFAction _ -> throw400 InvalidParams "query actions cannot be explained"
-    RFRaw _    -> pure $ Just $ encJFromJValue $ ExplainPlan fieldName Nothing Nothing
+    RFRaw _    -> pure $ encJFromJValue $ ExplainPlan fieldName Nothing Nothing
-    RFDB sourceName exists   -> dispatch [ do
+    RFDB sourceName exists   -> do
       step <- AB.dispatchAnyBackend @BackendExecute exists
         \(SourceConfigWith sourceConfig (QDBR db)) ->
            mkDBQueryExplain fieldName userInfo sourceName sourceConfig db
       AB.dispatchAnyBackend @BackendTransport step runDBQueryExplain
-        ,do
+
-      -- BigQuery case
-      SourceConfigWith _ (QDBR bqQDB) <-
-        hoistMaybe $ AB.unpackAnyBackend exists
-      lift $ do
-        actionsForest <- BigQuery.planToForest userInfo bqQDB
-        pure $ encJFromJValue $
-          ExplainPlan
-            fieldName
-            (Just ("--\n" <> BigQuery.drawActionsForestSQL actionsForest))
-            (Just ("": T.lines (BigQuery.drawActionsForest actionsForest)))]
-  where dispatch [] = pure Nothing
-        dispatch (x:xs) = do
-          mv <- runMaybeT x
-          case mv of
-            Nothing -> dispatch xs
-            Just v  -> pure (Just v)
 
 -- NOTE: This function has a 'MonadTrace' constraint in master, but we don't need it
 -- here. We should evaluate if we need it here.
@@ -112,8 +93,8 @@ explainGQLQuery sc (GQLExplain query userVarsRaw maybeIsRelay) = do
       inlinedSelSet <- E.inlineSelectionSet fragments selSet
       (unpreparedQueries, _, _) <-
         E.parseGraphQLQuery graphQLContext varDefs (GH._grVariables query) inlinedSelSet
-      encJFromList . catMaybes
+      encJFromList <$>
-        <$> for (OMap.toList unpreparedQueries) (uncurry (explainQueryField userInfo))
+        for (OMap.toList unpreparedQueries) (uncurry (explainQueryField userInfo))
 
     G.TypedOperationDefinition G.OperationTypeMutation _ _ _ _ ->
       throw400 InvalidParams "only queries can be explained"