mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
cf531b05cb
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
81 lines
3.5 KiB
Haskell
81 lines
3.5 KiB
Haskell
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
module Hasura.Backends.DataConnector.Agent.Client
|
|
( AgentClientContext (..),
|
|
AgentClientT,
|
|
runAgentClientT,
|
|
)
|
|
where
|
|
|
|
import Control.Exception (try)
|
|
import Control.Lens ((&~), (.=))
|
|
import Hasura.Backends.DataConnector.Logging (logAgentRequest, logClientError)
|
|
import Hasura.Base.Error
|
|
import Hasura.HTTP qualified
|
|
import Hasura.Logging (Hasura, Logger)
|
|
import Hasura.Prelude
|
|
import Hasura.Tracing (MonadTrace, traceHTTPRequest)
|
|
import Network.HTTP.Client (Manager)
|
|
import Network.HTTP.Client qualified as HTTP
|
|
import Network.HTTP.Client.Transformable qualified as TransformableHTTP
|
|
import Network.HTTP.Types.Status (Status)
|
|
import Servant.Client
|
|
import Servant.Client.Core (Request, RunClient (..))
|
|
import Servant.Client.Internal.HttpClient (clientResponseToResponse, mkFailureResponse)
|
|
|
|
data AgentClientContext = AgentClientContext
|
|
{ _accLogger :: Logger Hasura,
|
|
_accBaseUrl :: BaseUrl,
|
|
_accHttpManager :: Manager,
|
|
_accResponseTimeout :: Maybe Int
|
|
}
|
|
|
|
newtype AgentClientT m a = AgentClientT (ReaderT AgentClientContext m a)
|
|
deriving newtype (Functor, Applicative, Monad, MonadError e, MonadTrace, MonadIO)
|
|
|
|
runAgentClientT :: AgentClientT m a -> AgentClientContext -> m a
|
|
runAgentClientT (AgentClientT action) ctx = runReaderT action ctx
|
|
|
|
askClientContext :: Monad m => AgentClientT m AgentClientContext
|
|
askClientContext = AgentClientT ask
|
|
|
|
instance (MonadIO m, MonadTrace m, MonadError QErr m) => RunClient (AgentClientT m) where
|
|
runRequestAcceptStatus = runRequestAcceptStatus'
|
|
throwClientError = throwClientError'
|
|
|
|
runRequestAcceptStatus' :: (MonadIO m, MonadTrace m, MonadError QErr m) => Maybe [Status] -> Request -> (AgentClientT m) Response
|
|
runRequestAcceptStatus' acceptStatus req = do
|
|
AgentClientContext {..} <- askClientContext
|
|
let req' = defaultMakeClientRequest _accBaseUrl req
|
|
|
|
transformableReq <-
|
|
TransformableHTTP.tryFromClientRequest req'
|
|
`onLeft` (\err -> throw500 $ "Error in Data Connector backend: Could not create request. " <> err)
|
|
|
|
-- Set the response timeout explicitly if it is provided
|
|
let transformableReq' =
|
|
transformableReq &~ do
|
|
for _accResponseTimeout \x -> TransformableHTTP.timeout .= HTTP.responseTimeoutMicro x
|
|
|
|
(tracedReq, responseOrException) <- traceHTTPRequest transformableReq' \tracedReq ->
|
|
fmap (tracedReq,) . liftIO . try @HTTP.HttpException $ TransformableHTTP.performRequest tracedReq _accHttpManager
|
|
logAgentRequest _accLogger tracedReq responseOrException
|
|
case responseOrException of
|
|
-- throwConnectionError is used here in order to avoid a metadata inconsistency error
|
|
Left ex -> throwConnectionError $ "Error in Data Connector backend: " <> Hasura.HTTP.serializeHTTPExceptionMessage (Hasura.HTTP.HttpException ex)
|
|
Right response -> do
|
|
let status = TransformableHTTP.responseStatus response
|
|
servantResponse = clientResponseToResponse id response
|
|
goodStatus = case acceptStatus of
|
|
Nothing -> TransformableHTTP.statusIsSuccessful status
|
|
Just good -> status `elem` good
|
|
if goodStatus
|
|
then pure $ servantResponse
|
|
else throwClientError $ mkFailureResponse _accBaseUrl req servantResponse
|
|
|
|
throwClientError' :: (MonadIO m, MonadTrace m, MonadError QErr m) => ClientError -> (AgentClientT m) a
|
|
throwClientError' err = do
|
|
AgentClientContext {..} <- askClientContext
|
|
logClientError _accLogger err
|
|
throw500 $ "Error in Data Connector backend: " <> Hasura.HTTP.serializeServantClientErrorMessage err
|