-- | This module has the various metadata we want to attach to the
-- generated/executed query
module Hasura.QueryTags
  ( Attribute,
    LivequeryMetadata (LivequeryMetadata),
    MutationMetadata (MutationMetadata),
    QueryMetadata (QueryMetadata),
    QueryTags (QTLiveQuery, QTMutation, QTQuery),
    QueryTagsAttributes (_unQueryTagsAttributes),
    QueryTagsComment (..),
    emptyQueryTagsComment,
    encodeQueryTags,
    MonadQueryTags (..),

    -- * Exposed for testing
    emptyQueryTagsAttributes,
  )
where

import Data.Tagged
import Data.Text.Extended
import Hasura.GraphQL.Namespace (RootFieldAlias)
import Hasura.GraphQL.ParameterizedQueryHash
import Hasura.Prelude
import Hasura.QueryTags.Types
import Hasura.Server.Types (RequestId (..))
import Language.GraphQL.Draft.Syntax qualified as GQL

-- | Query Tags are SQL comments which are made up of (key=value) pairs.
--
-- These are appended to the SQL statements generated by Hasura for GraphQL
-- operations. This enables the ability to get some application context in the
-- database logs and also use native database monitoring tools (e.g. pganalyze)
-- for better performance analysis.
--
-- The application context(query tags) can be used to detect slow GQL operation and relate
-- them back to the SQL that was generated.
--
-- For eg: SELECT name FROM child /* request_id=487c2ed5-08a4-429a-b0e0-4666a82e3cc6, field_name=child, operation_name=GetChild */
--
-- For more usage information, refer [Query Tags Docs](https://hasura.io/docs/latest/graphql/cloud/query-tags.html)
data QueryTags
  = QTQuery !QueryMetadata
  | QTMutation !MutationMetadata
  | QTLiveQuery !LivequeryMetadata
  deriving (Int -> QueryTags -> ShowS
[QueryTags] -> ShowS
QueryTags -> String
(Int -> QueryTags -> ShowS)
-> (QueryTags -> String)
-> ([QueryTags] -> ShowS)
-> Show QueryTags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryTags -> ShowS
showsPrec :: Int -> QueryTags -> ShowS
$cshow :: QueryTags -> String
show :: QueryTags -> String
$cshowList :: [QueryTags] -> ShowS
showList :: [QueryTags] -> ShowS
Show)

-- | query-tags as SQL comment which is appended to the prepared SQL statement
newtype QueryTagsComment = QueryTagsComment {QueryTagsComment -> Text
_unQueryTagsComment :: Text} deriving (Int -> QueryTagsComment -> ShowS
[QueryTagsComment] -> ShowS
QueryTagsComment -> String
(Int -> QueryTagsComment -> ShowS)
-> (QueryTagsComment -> String)
-> ([QueryTagsComment] -> ShowS)
-> Show QueryTagsComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryTagsComment -> ShowS
showsPrec :: Int -> QueryTagsComment -> ShowS
$cshow :: QueryTagsComment -> String
show :: QueryTagsComment -> String
$cshowList :: [QueryTagsComment] -> ShowS
showList :: [QueryTagsComment] -> ShowS
Show, QueryTagsComment -> QueryTagsComment -> Bool
(QueryTagsComment -> QueryTagsComment -> Bool)
-> (QueryTagsComment -> QueryTagsComment -> Bool)
-> Eq QueryTagsComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryTagsComment -> QueryTagsComment -> Bool
== :: QueryTagsComment -> QueryTagsComment -> Bool
$c/= :: QueryTagsComment -> QueryTagsComment -> Bool
/= :: QueryTagsComment -> QueryTagsComment -> Bool
Eq)

type Attribute = (Text, Text)

newtype QueryTagsAttributes = QueryTagsAttributes {QueryTagsAttributes -> [Attribute]
_unQueryTagsAttributes :: [Attribute]} deriving (Int -> QueryTagsAttributes -> ShowS
[QueryTagsAttributes] -> ShowS
QueryTagsAttributes -> String
(Int -> QueryTagsAttributes -> ShowS)
-> (QueryTagsAttributes -> String)
-> ([QueryTagsAttributes] -> ShowS)
-> Show QueryTagsAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryTagsAttributes -> ShowS
showsPrec :: Int -> QueryTagsAttributes -> ShowS
$cshow :: QueryTagsAttributes -> String
show :: QueryTagsAttributes -> String
$cshowList :: [QueryTagsAttributes] -> ShowS
showList :: [QueryTagsAttributes] -> ShowS
Show, QueryTagsAttributes -> QueryTagsAttributes -> Bool
(QueryTagsAttributes -> QueryTagsAttributes -> Bool)
-> (QueryTagsAttributes -> QueryTagsAttributes -> Bool)
-> Eq QueryTagsAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryTagsAttributes -> QueryTagsAttributes -> Bool
== :: QueryTagsAttributes -> QueryTagsAttributes -> Bool
$c/= :: QueryTagsAttributes -> QueryTagsAttributes -> Bool
/= :: QueryTagsAttributes -> QueryTagsAttributes -> Bool
Eq)

emptyQueryTagsAttributes :: QueryTagsAttributes
emptyQueryTagsAttributes :: QueryTagsAttributes
emptyQueryTagsAttributes = [Attribute] -> QueryTagsAttributes
QueryTagsAttributes [Attribute]
forall a. Monoid a => a
mempty

emptyQueryTagsComment :: QueryTagsComment
emptyQueryTagsComment :: QueryTagsComment
emptyQueryTagsComment = Text -> QueryTagsComment
QueryTagsComment Text
forall a. Monoid a => a
mempty

data QueryMetadata = QueryMetadata
  { QueryMetadata -> Maybe RequestId
qmRequestId :: Maybe RequestId,
    QueryMetadata -> Maybe Name
qmOperationName :: Maybe GQL.Name,
    QueryMetadata -> RootFieldAlias
qmFieldName :: RootFieldAlias,
    QueryMetadata -> ParameterizedQueryHash
qmParameterizedQueryHash :: ParameterizedQueryHash
  }
  deriving (Int -> QueryMetadata -> ShowS
[QueryMetadata] -> ShowS
QueryMetadata -> String
(Int -> QueryMetadata -> ShowS)
-> (QueryMetadata -> String)
-> ([QueryMetadata] -> ShowS)
-> Show QueryMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryMetadata -> ShowS
showsPrec :: Int -> QueryMetadata -> ShowS
$cshow :: QueryMetadata -> String
show :: QueryMetadata -> String
$cshowList :: [QueryMetadata] -> ShowS
showList :: [QueryMetadata] -> ShowS
Show)

data MutationMetadata = MutationMetadata
  { MutationMetadata -> Maybe RequestId
mmRequestId :: Maybe RequestId,
    MutationMetadata -> Maybe Name
mmOperationName :: Maybe GQL.Name,
    MutationMetadata -> RootFieldAlias
mmFieldName :: RootFieldAlias,
    MutationMetadata -> ParameterizedQueryHash
mmParameterizedQueryHash :: ParameterizedQueryHash
  }
  deriving (Int -> MutationMetadata -> ShowS
[MutationMetadata] -> ShowS
MutationMetadata -> String
(Int -> MutationMetadata -> ShowS)
-> (MutationMetadata -> String)
-> ([MutationMetadata] -> ShowS)
-> Show MutationMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MutationMetadata -> ShowS
showsPrec :: Int -> MutationMetadata -> ShowS
$cshow :: MutationMetadata -> String
show :: MutationMetadata -> String
$cshowList :: [MutationMetadata] -> ShowS
showList :: [MutationMetadata] -> ShowS
Show)

data LivequeryMetadata = LivequeryMetadata
  { LivequeryMetadata -> RootFieldAlias
lqmFieldName :: RootFieldAlias,
    LivequeryMetadata -> ParameterizedQueryHash
lqmParameterizedQueryHash :: ParameterizedQueryHash
  }
  deriving (Int -> LivequeryMetadata -> ShowS
[LivequeryMetadata] -> ShowS
LivequeryMetadata -> String
(Int -> LivequeryMetadata -> ShowS)
-> (LivequeryMetadata -> String)
-> ([LivequeryMetadata] -> ShowS)
-> Show LivequeryMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LivequeryMetadata -> ShowS
showsPrec :: Int -> LivequeryMetadata -> ShowS
$cshow :: LivequeryMetadata -> String
show :: LivequeryMetadata -> String
$cshowList :: [LivequeryMetadata] -> ShowS
showList :: [LivequeryMetadata] -> ShowS
Show)

encodeQueryTags :: QueryTags -> QueryTagsAttributes
encodeQueryTags :: QueryTags -> QueryTagsAttributes
encodeQueryTags = \case
  QTQuery QueryMetadata
queryMetadata -> [Attribute] -> QueryTagsAttributes
QueryTagsAttributes ([Attribute] -> QueryTagsAttributes)
-> [Attribute] -> QueryTagsAttributes
forall a b. (a -> b) -> a -> b
$ QueryMetadata -> [Attribute]
encodeQueryMetadata QueryMetadata
queryMetadata
  QTMutation MutationMetadata
mutationMetadata -> [Attribute] -> QueryTagsAttributes
QueryTagsAttributes ([Attribute] -> QueryTagsAttributes)
-> [Attribute] -> QueryTagsAttributes
forall a b. (a -> b) -> a -> b
$ MutationMetadata -> [Attribute]
encodeMutationMetadata MutationMetadata
mutationMetadata
  QTLiveQuery LivequeryMetadata
livequeryMetadata -> [Attribute] -> QueryTagsAttributes
QueryTagsAttributes ([Attribute] -> QueryTagsAttributes)
-> [Attribute] -> QueryTagsAttributes
forall a b. (a -> b) -> a -> b
$ LivequeryMetadata -> [Attribute]
forall {a}. IsString a => LivequeryMetadata -> [(a, Text)]
encodeLivequeryMetadata LivequeryMetadata
livequeryMetadata
  where
    -- TODO: how do we want to encode RootFieldAlias?
    -- Currently uses ToTxt instance, which produces "namespace.fieldname"
    encodeQueryMetadata :: QueryMetadata -> [Attribute]
encodeQueryMetadata QueryMetadata {Maybe Name
Maybe RequestId
ParameterizedQueryHash
RootFieldAlias
qmRequestId :: QueryMetadata -> Maybe RequestId
qmOperationName :: QueryMetadata -> Maybe Name
qmFieldName :: QueryMetadata -> RootFieldAlias
qmParameterizedQueryHash :: QueryMetadata -> ParameterizedQueryHash
qmRequestId :: Maybe RequestId
qmOperationName :: Maybe Name
qmFieldName :: RootFieldAlias
qmParameterizedQueryHash :: ParameterizedQueryHash
..} =
      Maybe Attribute -> [Attribute]
forall a. Maybe a -> [a]
maybeToList ((,) Text
"request_id" (Text -> Attribute)
-> (RequestId -> Text) -> RequestId -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestId -> Text
unRequestId (RequestId -> Attribute) -> Maybe RequestId -> Maybe Attribute
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RequestId
qmRequestId)
        [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [ (Text
"field_name", RootFieldAlias -> Text
forall a. ToTxt a => a -> Text
toTxt RootFieldAlias
qmFieldName),
             (Text
"parameterized_query_hash", ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ParameterizedQueryHash -> ByteString
unParamQueryHash ParameterizedQueryHash
qmParameterizedQueryHash)
           ]
        [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> Maybe Name -> [Attribute]
operationNameAttributes Maybe Name
qmOperationName

    encodeMutationMetadata :: MutationMetadata -> [Attribute]
encodeMutationMetadata MutationMetadata {Maybe Name
Maybe RequestId
ParameterizedQueryHash
RootFieldAlias
mmRequestId :: MutationMetadata -> Maybe RequestId
mmOperationName :: MutationMetadata -> Maybe Name
mmFieldName :: MutationMetadata -> RootFieldAlias
mmParameterizedQueryHash :: MutationMetadata -> ParameterizedQueryHash
mmRequestId :: Maybe RequestId
mmOperationName :: Maybe Name
mmFieldName :: RootFieldAlias
mmParameterizedQueryHash :: ParameterizedQueryHash
..} =
      Maybe Attribute -> [Attribute]
forall a. Maybe a -> [a]
maybeToList ((,) Text
"request_id" (Text -> Attribute)
-> (RequestId -> Text) -> RequestId -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestId -> Text
unRequestId (RequestId -> Attribute) -> Maybe RequestId -> Maybe Attribute
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RequestId
mmRequestId)
        [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> [ (Text
"field_name", RootFieldAlias -> Text
forall a. ToTxt a => a -> Text
toTxt RootFieldAlias
mmFieldName),
             (Text
"parameterized_query_hash", ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ParameterizedQueryHash -> ByteString
unParamQueryHash ParameterizedQueryHash
mmParameterizedQueryHash)
           ]
        [Attribute] -> [Attribute] -> [Attribute]
forall a. Semigroup a => a -> a -> a
<> Maybe Name -> [Attribute]
operationNameAttributes Maybe Name
mmOperationName

    encodeLivequeryMetadata :: LivequeryMetadata -> [(a, Text)]
encodeLivequeryMetadata LivequeryMetadata {ParameterizedQueryHash
RootFieldAlias
lqmFieldName :: LivequeryMetadata -> RootFieldAlias
lqmParameterizedQueryHash :: LivequeryMetadata -> ParameterizedQueryHash
lqmFieldName :: RootFieldAlias
lqmParameterizedQueryHash :: ParameterizedQueryHash
..} =
      [ (a
"field_name", RootFieldAlias -> Text
forall a. ToTxt a => a -> Text
toTxt RootFieldAlias
lqmFieldName),
        (a
"parameterized_query_hash", ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ParameterizedQueryHash -> ByteString
unParamQueryHash ParameterizedQueryHash
lqmParameterizedQueryHash)
      ]

operationNameAttributes :: Maybe GQL.Name -> [(Text, Text)]
operationNameAttributes :: Maybe Name -> [Attribute]
operationNameAttributes = [Attribute] -> (Name -> [Attribute]) -> Maybe Name -> [Attribute]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Name
opName -> [(Text
"operation_name", Name -> Text
GQL.unName Name
opName)])

class (Monad m) => MonadQueryTags m where
  -- | Creates Query Tags. These are appended to the Generated SQL.
  -- Helps users to use native database monitoring tools to get some 'application-context'.
  createQueryTags ::
    QueryTagsAttributes -> Maybe QueryTagsConfig -> Tagged m QueryTagsComment
  default createQueryTags :: forall t n. (m ~ t n, MonadQueryTags n) => QueryTagsAttributes -> Maybe QueryTagsConfig -> Tagged m QueryTagsComment
  createQueryTags QueryTagsAttributes
qtSourceConfig Maybe QueryTagsConfig
attr = Tagged n QueryTagsComment -> Tagged (t n) QueryTagsComment
forall {k1} {k2} (s :: k1) b (t :: k2). Tagged s b -> Tagged t b
retag (forall (m :: * -> *).
MonadQueryTags m =>
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged m QueryTagsComment
createQueryTags @n QueryTagsAttributes
qtSourceConfig Maybe QueryTagsConfig
attr) :: Tagged (t n) QueryTagsComment

instance (MonadQueryTags m) => MonadQueryTags (ReaderT r m)

instance (MonadQueryTags m) => MonadQueryTags (ExceptT e m)