graphql-engine/server/src-lib/Hasura/Backends/MySQL/Instances/Transport.hs
Daniel Harvey 95f5553af6 chore(server): split new statistics log from QueryLog
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8326
GitOrigin-RevId: 02ee652302de5328e63054a6448dca10de7b5c1b
2023-03-15 13:06:47 +00:00

82 lines
2.6 KiB
Haskell

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hasura.Backends.MySQL.Instances.Transport (runQuery) where
import Control.Monad.Trans.Control
import Data.Aeson qualified as J
import Data.Text.Extended
import Hasura.Backends.MySQL.Instances.Execute ()
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Execute.Backend
import Hasura.GraphQL.Logging
import Hasura.GraphQL.Namespace (RootFieldAlias)
import Hasura.GraphQL.Transport.Backend
import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.Logging qualified as L
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.SQL.AnyBackend (AnyBackend)
import Hasura.SQL.Backend
import Hasura.Server.Types (RequestId)
import Hasura.Session
import Hasura.Tracing
instance BackendTransport 'MySQL where
runDBQuery = runQuery
runDBQueryExplain = runQueryExplain
runDBMutation = error "runDBMutation: MySQL backend does not support this operation yet."
runDBSubscription = error "runDBSubscription: MySQL backend does not support this operation yet."
runDBStreamingSubscription = error "runDBStreamingSubscription: MySQL backend does not support this operation yet"
runQuery ::
( MonadIO m,
MonadBaseControl IO m,
MonadQueryLog m,
MonadTrace m,
MonadError QErr m
) =>
RequestId ->
GQLReqUnparsed ->
RootFieldAlias ->
UserInfo ->
L.Logger L.Hasura ->
SourceConfig 'MySQL ->
OnBaseMonad IdentityT (Maybe (AnyBackend ExecutionStats), EncJSON) ->
Maybe (PreparedQuery 'MySQL) ->
ResolvedConnectionTemplate 'MySQL ->
-- | Also return the time spent in the PG query; for telemetry.
m (DiffTime, EncJSON)
runQuery reqId query fieldName _userInfo logger _sourceConfig tx genSql _ = do
logQueryLog logger $ mkQueryLog query fieldName genSql reqId
withElapsedTime $
newSpan ("MySQL Query for root field " <>> fieldName) $
fmap snd (run tx)
runQueryExplain ::
( MonadIO m,
MonadBaseControl IO m,
MonadError QErr m,
MonadTrace m
) =>
DBStepInfo 'MySQL ->
m EncJSON
runQueryExplain (DBStepInfo _ _ _ action _) = fmap arResult (run action)
run :: (MonadIO m, MonadBaseControl IO m, MonadError QErr m, MonadTrace m) => OnBaseMonad IdentityT a -> m a
run = runIdentityT . runOnBaseMonad
mkQueryLog ::
GQLReqUnparsed ->
RootFieldAlias ->
Maybe (PreparedQuery 'MySQL) ->
RequestId ->
QueryLog
mkQueryLog gqlQuery fieldName preparedSql requestId =
-- @QueryLogKindDatabase Nothing@ means that the backend doesn't support connection templates
QueryLog gqlQuery ((fieldName,) <$> generatedQuery) requestId (QueryLogKindDatabase Nothing)
where
generatedQuery =
preparedSql <&> \queryString ->
GeneratedQuery queryString J.Null