-- | 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,

    -- * Exposed for testing
    emptyQueryTagsAttributes,
  )
where

import Data.Text.Extended
import Hasura.GraphQL.Namespace (RootFieldAlias)
import Hasura.GraphQL.ParameterizedQueryHash
import Hasura.Prelude
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
showList :: [QueryTags] -> ShowS
$cshowList :: [QueryTags] -> ShowS
show :: QueryTags -> String
$cshow :: QueryTags -> String
showsPrec :: Int -> QueryTags -> ShowS
$cshowsPrec :: Int -> 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
showList :: [QueryTagsComment] -> ShowS
$cshowList :: [QueryTagsComment] -> ShowS
show :: QueryTagsComment -> String
$cshow :: QueryTagsComment -> String
showsPrec :: Int -> QueryTagsComment -> ShowS
$cshowsPrec :: Int -> QueryTagsComment -> ShowS
Show, QueryTagsComment -> QueryTagsComment -> Bool
(QueryTagsComment -> QueryTagsComment -> Bool)
-> (QueryTagsComment -> QueryTagsComment -> Bool)
-> Eq QueryTagsComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryTagsComment -> QueryTagsComment -> Bool
$c/= :: QueryTagsComment -> QueryTagsComment -> Bool
== :: QueryTagsComment -> QueryTagsComment -> Bool
$c== :: 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
showList :: [QueryTagsAttributes] -> ShowS
$cshowList :: [QueryTagsAttributes] -> ShowS
show :: QueryTagsAttributes -> String
$cshow :: QueryTagsAttributes -> String
showsPrec :: Int -> QueryTagsAttributes -> ShowS
$cshowsPrec :: Int -> QueryTagsAttributes -> ShowS
Show, QueryTagsAttributes -> QueryTagsAttributes -> Bool
(QueryTagsAttributes -> QueryTagsAttributes -> Bool)
-> (QueryTagsAttributes -> QueryTagsAttributes -> Bool)
-> Eq QueryTagsAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryTagsAttributes -> QueryTagsAttributes -> Bool
$c/= :: QueryTagsAttributes -> QueryTagsAttributes -> Bool
== :: QueryTagsAttributes -> QueryTagsAttributes -> Bool
$c== :: 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 -> RequestId
qmRequestId :: !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
showList :: [QueryMetadata] -> ShowS
$cshowList :: [QueryMetadata] -> ShowS
show :: QueryMetadata -> String
$cshow :: QueryMetadata -> String
showsPrec :: Int -> QueryMetadata -> ShowS
$cshowsPrec :: Int -> QueryMetadata -> ShowS
Show)

data MutationMetadata = MutationMetadata
  { MutationMetadata -> RequestId
mmRequestId :: !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
showList :: [MutationMetadata] -> ShowS
$cshowList :: [MutationMetadata] -> ShowS
show :: MutationMetadata -> String
$cshow :: MutationMetadata -> String
showsPrec :: Int -> MutationMetadata -> ShowS
$cshowsPrec :: Int -> 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
showList :: [LivequeryMetadata] -> ShowS
$cshowList :: [LivequeryMetadata] -> ShowS
show :: LivequeryMetadata -> String
$cshow :: LivequeryMetadata -> String
showsPrec :: Int -> LivequeryMetadata -> ShowS
$cshowsPrec :: Int -> 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
ParameterizedQueryHash
RequestId
RootFieldAlias
qmParameterizedQueryHash :: ParameterizedQueryHash
qmFieldName :: RootFieldAlias
qmOperationName :: Maybe Name
qmRequestId :: RequestId
qmParameterizedQueryHash :: QueryMetadata -> ParameterizedQueryHash
qmFieldName :: QueryMetadata -> RootFieldAlias
qmOperationName :: QueryMetadata -> Maybe Name
qmRequestId :: QueryMetadata -> RequestId
..} =
      [ (Text
"request_id", RequestId -> Text
unRequestId RequestId
qmRequestId),
        (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
ParameterizedQueryHash
RequestId
RootFieldAlias
mmParameterizedQueryHash :: ParameterizedQueryHash
mmFieldName :: RootFieldAlias
mmOperationName :: Maybe Name
mmRequestId :: RequestId
mmParameterizedQueryHash :: MutationMetadata -> ParameterizedQueryHash
mmFieldName :: MutationMetadata -> RootFieldAlias
mmOperationName :: MutationMetadata -> Maybe Name
mmRequestId :: MutationMetadata -> RequestId
..} =
      [ (Text
"request_id", RequestId -> Text
unRequestId RequestId
mmRequestId),
        (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
lqmParameterizedQueryHash :: ParameterizedQueryHash
lqmFieldName :: RootFieldAlias
lqmParameterizedQueryHash :: LivequeryMetadata -> ParameterizedQueryHash
lqmFieldName :: LivequeryMetadata -> RootFieldAlias
..} =
      [ (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)])