PG span tracing improvements (close hasura#465) (hasura#5607)

* Better name for Fetch Data

* Changing tracing to distinguish PG

* Changing trace names

* Finer-grained PG tracing

* Update WebSocket.hs

Co-authored-by: Phil Freeman <paf31@cantab.net>
Co-authored-by: Phil Freeman <phil@hasura.io>

server/src-lib/Hasura/GraphQL/Execute/Query.hs

@@ -317,7 +317,7 @@ mkLazyRespTx env manager reqHdrs userInfo resolved = do
       RRSql (PreparedSql q args maybeRemoteJoins) -> do
         let prepArgs = map fst args
         case maybeRemoteJoins of
-          Nothing -> liftTx $ asSingleRowJsonResp q prepArgs
+          Nothing -> Tracing.trace "Postgres" . liftTx $ asSingleRowJsonResp q prepArgs
           Just remoteJoins ->
             executeQueryWithRemoteJoins env manager reqHdrs userInfo q prepArgs remoteJoins
     return (G.unName $ G.unAlias alias, resp)

server/src-lib/Hasura/GraphQL/Transport/HTTP.hs

@@ -168,15 +168,16 @@ runHasuraGQ
 runHasuraGQ reqId (query, queryParsed) userInfo resolvedOp = do
   (E.ExecutionCtx logger _ pgExecCtx _ _ _ _ _) <- ask
   (telemTimeIO, respE) <- withElapsedTime $ runExceptT $ case resolvedOp of
-    E.ExOpQuery tx genSql asts -> trace "pg" $ do
+    E.ExOpQuery tx genSql asts -> trace "Query" $ do
       -- log the generated SQL and the graphql query
       logQueryLog logger query genSql reqId
       Tracing.interpTraceT id $ executeQuery queryParsed asts genSql pgExecCtx Q.ReadOnly tx
 
-    E.ExOpMutation respHeaders tx -> trace "pg" $ do
+    E.ExOpMutation respHeaders tx -> trace "Mutate" $ do
       logQueryLog logger query Nothing reqId
       ctx <- Tracing.currentContext
-      (respHeaders,) <$> Tracing.interpTraceT (runLazyTx pgExecCtx Q.ReadWrite . withTraceContext ctx . withUserInfo userInfo) tx
+      (respHeaders,) <$>
+        Tracing.interpTraceT (runLazyTx pgExecCtx Q.ReadWrite . withTraceContext ctx . withUserInfo userInfo) tx
 
     E.ExOpSubs _ ->
       throw400 UnexpectedPayload

server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs

@@ -363,11 +363,11 @@ onStart env serverEnv wsConn (StartMsg opId q) = catchAndIgnore $ do
       -> E.ExecOp (Tracing.TraceT (LazyTx QErr))
       -> ExceptT () m ()
     runHasuraGQ timerTot telemCacheHit reqId query queryParsed userInfo = \case
-      E.ExOpQuery opTx genSql asts -> Tracing.trace "pg" $
+      E.ExOpQuery opTx genSql asts -> Tracing.trace "Query" $
         execQueryOrMut Telem.Query genSql . fmap snd $
           Tracing.interpTraceT id $ executeQuery queryParsed asts genSql pgExecCtx Q.ReadOnly opTx
       -- Response headers discarded over websockets
-      E.ExOpMutation _ opTx -> Tracing.trace "pg" do
+      E.ExOpMutation _ opTx -> Tracing.trace "Mutate" do
         ctx <- Tracing.currentContext
         execQueryOrMut Telem.Mutation Nothing $
           Tracing.interpTraceT (runLazyTx pgExecCtx Q.ReadWrite . withTraceContext ctx . withUserInfo userInfo) opTx

server/src-lib/Hasura/RQL/DML/RemoteJoin.hs

@@ -61,7 +61,7 @@ executeQueryWithRemoteJoins
   -> m EncJSON
 executeQueryWithRemoteJoins env manager reqHdrs userInfo q prepArgs rjs = do
   -- Step 1: Perform the query on database and fetch the response
-  pgRes <- runIdentity . Q.getRow <$> liftTx (Q.rawQE dmlTxErrorHandler q prepArgs True)
+  pgRes <- runIdentity . Q.getRow <$> Tracing.trace "Postgres" (liftTx (Q.rawQE dmlTxErrorHandler q prepArgs True))
   jsonRes <- either (throw500 . T.pack) pure $ AO.eitherDecode pgRes
   -- Step 2: Traverse through the JSON obtained in above step and generate composite JSON value with remote joins
   compositeJson <- traverseQueryResponseJSON rjMap jsonRes