graphql-engine/server/src-lib/Hasura/Backends/DataConnector/Adapter/Transport.hs
Antoine Leblanc cf531b05cb Rewrite Tracing to allow for only one TraceT in the entire stack.
This PR is on top of #7789.

### Description

This PR entirely rewrites the API of the Tracing library, to make `interpTraceT` a thing of the past. Before this change, we ran traces by sticking a `TraceT` on top of whatever we were doing. This had several major drawbacks:
- we were carrying a bunch of `TraceT` across the codebase, and the entire codebase had to know about it
- we needed to carry a second class constraint around (`HasReporterM`) to be able to run all of those traces
- we kept having to do stack rewriting with `interpTraceT`, which went from inconvenient to horrible
- we had to declare several behavioral instances on `TraceT m`

This PR rewrite all of `Tracing` using a more conventional model: there is ONE `TraceT` at the bottom of the stack, and there is an associated class constraint `MonadTrace`: any part of the code that happens to satisfy `MonadTrace` is able to create new traces. We NEVER have to do stack rewriting, `interpTraceT` is gone, and `TraceT` and `Reporter` become  implementation details that 99% of the code is blissfully unaware of: code that needs to do tracing only needs to declare that the monad in which it operates implements `MonadTrace`.

In doing so, this PR revealed **several bugs in the codebase**: places where we were expecting to trace something, but due to the default instance of `HasReporterM IO` we would actually not do anything. This PR also splits the code of `Tracing` in more byte-sized modules, with the goal of potentially moving to `server/lib` down the line.

### Remaining work

This PR is a draft; what's left to do is:
- [x] make Pro compile; i haven't updated `HasuraPro/Main` yet
- [x] document Tracing by writing a note that explains how to use the library, and the meaning of "reporter", "trace" and "span", as well as the pitfalls
- [x] discuss some of the trade-offs in the implementation, which is why i'm opening this PR already despite it not fully building yet
- [x] it depends on #7789 being merged first

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7791
GitOrigin-RevId: cadd32d039134c93ddbf364599a2f4dd988adea8
2023-03-13 17:38:39 +00:00

115 lines
4.1 KiB
Haskell

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hasura.Backends.DataConnector.Adapter.Transport () where
--------------------------------------------------------------------------------
import Control.Exception.Safe (throwIO)
import Control.Monad.Trans.Control
import Data.Aeson qualified as J
import Data.Text.Extended ((<>>))
import Hasura.Backends.DataConnector.Adapter.Execute (DataConnectorPreparedQuery (..), encodePreparedQueryToJsonText)
import Hasura.Backends.DataConnector.Adapter.Types (SourceConfig (..))
import Hasura.Backends.DataConnector.Agent.Client (AgentClientContext (..), AgentClientT, runAgentClientT)
import Hasura.Base.Error (QErr)
import Hasura.EncJSON (EncJSON)
import Hasura.GraphQL.Execute.Backend (DBStepInfo (..), OnBaseMonad (..))
import Hasura.GraphQL.Logging qualified as HGL
import Hasura.GraphQL.Namespace (RootFieldAlias)
import Hasura.GraphQL.Transport.Backend (BackendTransport (..))
import Hasura.GraphQL.Transport.HTTP.Protocol (GQLReqUnparsed)
import Hasura.Logging (Hasura, Logger, nullLogger)
import Hasura.Prelude
import Hasura.RQL.Types.Backend (ResolvedConnectionTemplate)
import Hasura.SQL.Backend (BackendType (DataConnector))
import Hasura.Server.Types (RequestId)
import Hasura.Session (UserInfo)
import Hasura.Tracing qualified as Tracing
--------------------------------------------------------------------------------
instance BackendTransport 'DataConnector where
runDBQuery = runDBQuery'
runDBQueryExplain = runDBQueryExplain'
runDBMutation = runDBMutation'
runDBStreamingSubscription _ _ _ _ =
liftIO . throwIO $ userError "runDBStreamingSubscription: not implemented for the Data Connector backend."
runDBSubscription _ _ _ _ =
liftIO . throwIO $ userError "runDBSubscription: not implemented for the Data Connector backend."
runDBQuery' ::
( MonadIO m,
MonadBaseControl IO m,
MonadError QErr m,
Tracing.MonadTrace m,
HGL.MonadQueryLog m
) =>
RequestId ->
GQLReqUnparsed ->
RootFieldAlias ->
UserInfo ->
Logger Hasura ->
SourceConfig ->
OnBaseMonad AgentClientT a ->
Maybe DataConnectorPreparedQuery ->
ResolvedConnectionTemplate 'DataConnector ->
m (DiffTime, a)
runDBQuery' requestId query fieldName _userInfo logger SourceConfig {..} action queryRequest _ = do
void $ HGL.logQueryLog logger $ mkQueryLog query fieldName queryRequest requestId
withElapsedTime
. Tracing.newSpan ("Data Connector backend query for root field " <>> fieldName)
. flip runAgentClientT (AgentClientContext logger _scEndpoint _scManager _scTimeoutMicroseconds)
. runOnBaseMonad
$ action
mkQueryLog ::
GQLReqUnparsed ->
RootFieldAlias ->
Maybe DataConnectorPreparedQuery ->
RequestId ->
HGL.QueryLog
mkQueryLog gqlQuery fieldName maybeQuery requestId =
HGL.QueryLog
gqlQuery
((\query -> (fieldName, HGL.GeneratedQuery (encodePreparedQueryToJsonText query) J.Null)) <$> maybeQuery)
requestId
-- @QueryLogKindDatabase Nothing@ means that the backend doesn't support connection templates
(HGL.QueryLogKindDatabase Nothing)
runDBQueryExplain' ::
( MonadIO m,
MonadBaseControl IO m,
MonadError QErr m,
Tracing.MonadTrace m
) =>
DBStepInfo 'DataConnector ->
m EncJSON
runDBQueryExplain' (DBStepInfo _ SourceConfig {..} _ action _) =
flip runAgentClientT (AgentClientContext nullLogger _scEndpoint _scManager _scTimeoutMicroseconds) $
runOnBaseMonad action
runDBMutation' ::
( MonadIO m,
MonadBaseControl IO m,
MonadError QErr m,
Tracing.MonadTrace m,
HGL.MonadQueryLog m
) =>
RequestId ->
GQLReqUnparsed ->
RootFieldAlias ->
UserInfo ->
Logger Hasura ->
SourceConfig ->
OnBaseMonad AgentClientT a ->
Maybe DataConnectorPreparedQuery ->
ResolvedConnectionTemplate 'DataConnector ->
m (DiffTime, a)
runDBMutation' requestId query fieldName _userInfo logger SourceConfig {..} action queryRequest _ = do
void $ HGL.logQueryLog logger $ mkQueryLog query fieldName queryRequest requestId
withElapsedTime
. Tracing.newSpan ("Data Connector backend mutation for root field " <>> fieldName)
. flip runAgentClientT (AgentClientContext logger _scEndpoint _scManager _scTimeoutMicroseconds)
. runOnBaseMonad
$ action