mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 21:12:09 +03:00
11a454c2d6
This commit applies ormolu to the whole Haskell code base by running `make format`. For in-flight branches, simply merging changes from `main` will result in merge conflicts. To avoid this, update your branch using the following instructions. Replace `<format-commit>` by the hash of *this* commit. $ git checkout my-feature-branch $ git merge <format-commit>^ # and resolve conflicts normally $ make format $ git commit -a -m "reformat with ormolu" $ git merge -s ours post-ormolu https://github.com/hasura/graphql-engine-mono/pull/2404 GitOrigin-RevId: 75049f5c12f430c615eafb4c6b8e83e371e01c8e
90 lines
2.6 KiB
Haskell
90 lines
2.6 KiB
Haskell
-- |
|
|
-- This module holds functions and data types used for logging at the GraphQL
|
|
-- layer. In contrast with, logging at the HTTP server layer.
|
|
module Hasura.GraphQL.Logging
|
|
( QueryLog (..),
|
|
GeneratedQuery (..),
|
|
MonadQueryLog (..),
|
|
QueryLogKind (..),
|
|
)
|
|
where
|
|
|
|
import Data.Aeson qualified as J
|
|
import Data.HashMap.Strict qualified as Map
|
|
import Hasura.GraphQL.Transport.HTTP.Protocol (GQLReqUnparsed)
|
|
import Hasura.Logging qualified as L
|
|
import Hasura.Metadata.Class
|
|
import Hasura.Prelude
|
|
import Hasura.Server.Types (RequestId)
|
|
import Hasura.Tracing (TraceT)
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
|
|
-- | A GraphQL query, optionally generated SQL, and the request id makes up the
|
|
-- | 'QueryLog'
|
|
data QueryLog = QueryLog
|
|
{ _qlQuery :: !GQLReqUnparsed,
|
|
_qlGeneratedSql :: !(Maybe (G.Name, GeneratedQuery)),
|
|
_qlRequestId :: !RequestId,
|
|
_qlKind :: !QueryLogKind
|
|
}
|
|
|
|
data QueryLogKind
|
|
= QueryLogKindDatabase
|
|
| QueryLogKindAction
|
|
| QueryLogKindRemoteSchema
|
|
| QueryLogKindCached
|
|
| QueryLogKindIntrospection
|
|
|
|
instance J.ToJSON QueryLogKind where
|
|
toJSON = \case
|
|
QueryLogKindDatabase -> "database"
|
|
QueryLogKindAction -> "action"
|
|
QueryLogKindRemoteSchema -> "remote-schema"
|
|
QueryLogKindCached -> "cached"
|
|
QueryLogKindIntrospection -> "introspection"
|
|
|
|
data GeneratedQuery = GeneratedQuery
|
|
{ _gqQueryString :: Text,
|
|
_gqPreparedArgs :: J.Value
|
|
}
|
|
|
|
instance J.ToJSON QueryLog where
|
|
toJSON (QueryLog gqlQuery generatedQuery reqId kind) =
|
|
J.object
|
|
[ "query" J..= gqlQuery,
|
|
-- NOTE: this customizes the default JSON instance of a pair
|
|
"generated_sql" J..= fmap fromPair generatedQuery,
|
|
"request_id" J..= reqId,
|
|
"kind" J..= kind
|
|
]
|
|
where
|
|
fromPair p = Map.fromList [first G.unName p]
|
|
|
|
instance J.ToJSON GeneratedQuery where
|
|
toJSON (GeneratedQuery queryString preparedArgs) =
|
|
J.object
|
|
[ "query" J..= queryString,
|
|
"prepared_arguments" J..= preparedArgs
|
|
]
|
|
|
|
instance L.ToEngineLog QueryLog L.Hasura where
|
|
toEngineLog ql = (L.LevelInfo, L.ELTQueryLog, J.toJSON ql)
|
|
|
|
class Monad m => MonadQueryLog m where
|
|
logQueryLog ::
|
|
L.Logger L.Hasura ->
|
|
QueryLog ->
|
|
m ()
|
|
|
|
instance MonadQueryLog m => MonadQueryLog (ExceptT e m) where
|
|
logQueryLog logger l = lift $ logQueryLog logger l
|
|
|
|
instance MonadQueryLog m => MonadQueryLog (ReaderT r m) where
|
|
logQueryLog logger l = lift $ logQueryLog logger l
|
|
|
|
instance MonadQueryLog m => MonadQueryLog (TraceT m) where
|
|
logQueryLog logger l = lift $ logQueryLog logger l
|
|
|
|
instance MonadQueryLog m => MonadQueryLog (MetadataStorageT m) where
|
|
logQueryLog logger l = lift $ logQueryLog logger l
|