-- |
-- This module calculates parameterized query hash, which is a way to
-- hash an incoming query (after resolving variables) with all leaf nodes
-- (i.e. scalar values) discarded. In other words, two queries having the same
-- parameterized query hash are essentially the same query but may differ in
-- leaf values.
--
-- For example:
--
-- 1. query {
--      authors (where: {id: {_eq: 2}}) {
--        id
--        name
--      }
--    }
--
-- 2. query {
--      authors (where: {id: {_eq: 203943}}) {
--        id
--        name
--      }
--    }
--
-- 3. query {
--      authors (where: {id: {_eq: $id}}) {
--        id
--        name
--      }
--    }
--
--   For any value of `id`
--
-- 4. query {
--      authors (where: $whereBoolExp) {
--        id
--        name
--      }
--    }
--
--    only when `whereBoolExp` is of the form of
--
--    {
--       "id": {
--         "_eq": <id>
--       }
--    }
--
-- All the above queries should result in the same parameterized query hash.
--
-- The following steps are done to calculate the parameterized query hash:
--
-- 1. Normalize the GraphQL query by substituting the variables (if any) in appropriate places.
-- 2. Substitute any scalar GraphQL values (Int, Float, Enum, String and Boolean) to null
-- 3. For input objects and list, traverse through them and do step no 2.
-- 4. Calculate the hash of the query obtained from step 3.
--
-- Note: Parameterized query hash is a PRO only feature
module Hasura.GraphQL.ParameterizedQueryHash
  ( calculateParameterizedQueryHash,
    mkUnsafeParameterizedQueryHash,
    unParamQueryHash,
    ParameterizedQueryHash,
    ParameterizedQueryHashList (..),
    parameterizedQueryHashListToObject,
  )
where

import Data.Aeson qualified as J
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString qualified as B
import Data.HashMap.Strict qualified as HashMap
import Data.Hashable (Hashable (hashWithSalt))
import Hasura.GraphQL.Parser (InputValue (..), Variable (..))
import Hasura.Prelude
import Hasura.Server.Utils (cryptoHash)
import Language.GraphQL.Draft.Printer qualified as G
import Language.GraphQL.Draft.Syntax qualified as G
import Text.Builder qualified as Text

-- | a set of parameterized query hashes attached to a request
-- this type exists because a simple list of 'ParameterisedQueryHash'es won't
-- let us log a single-request batch and a single non-batched request
-- differently. the log format uses json lists for requests executed in batched
-- mode, for fields like @query@, but not for requests in single mode (e.g.
-- @query: "..."@ vs @query: ["..."]@) and so to conform to that, we capture the
-- whole _set_ of parameterised query hashes when it's created, tagging it with
-- information about how it was created (i.e. from a batched request, a single
-- request, etc.)
data ParameterizedQueryHashList
  = -- | an empty query hash set, either for an operation that does not produce
    -- query hashes, or due to failure in operation execution
    PQHSetEmpty
  | -- | a query hash set consisting of a single element, corresponding to e.g.
    -- a single (non-batched) graphql request
    PQHSetSingleton !ParameterizedQueryHash
  | -- | a query hash set associated to a batched request
    -- note that this does not need to contain multiple query hashes: it is possible
    -- for a batch to contain only one request
    PQHSetBatched ![ParameterizedQueryHash]
  deriving (Int -> ParameterizedQueryHashList -> ShowS
[ParameterizedQueryHashList] -> ShowS
ParameterizedQueryHashList -> String
(Int -> ParameterizedQueryHashList -> ShowS)
-> (ParameterizedQueryHashList -> String)
-> ([ParameterizedQueryHashList] -> ShowS)
-> Show ParameterizedQueryHashList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParameterizedQueryHashList -> ShowS
showsPrec :: Int -> ParameterizedQueryHashList -> ShowS
$cshow :: ParameterizedQueryHashList -> String
show :: ParameterizedQueryHashList -> String
$cshowList :: [ParameterizedQueryHashList] -> ShowS
showList :: [ParameterizedQueryHashList] -> ShowS
Show, ParameterizedQueryHashList -> ParameterizedQueryHashList -> Bool
(ParameterizedQueryHashList -> ParameterizedQueryHashList -> Bool)
-> (ParameterizedQueryHashList
    -> ParameterizedQueryHashList -> Bool)
-> Eq ParameterizedQueryHashList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParameterizedQueryHashList -> ParameterizedQueryHashList -> Bool
== :: ParameterizedQueryHashList -> ParameterizedQueryHashList -> Bool
$c/= :: ParameterizedQueryHashList -> ParameterizedQueryHashList -> Bool
/= :: ParameterizedQueryHashList -> ParameterizedQueryHashList -> Bool
Eq)

-- | we use something that explicitly produces an 'J.Object' instead of writing
-- a 'J.ToJSON' instance. in the latter case, functions consuming the output of
-- 'J.toJSON' would have to perform a partial pattern-match on the 'J.Value'
-- output to extract a JSON object from it. for the other patterns, it would
-- have to either throw a runtime error on or silently ignore the other
-- patterns, and the latter choice would cause a silent failure if the
-- 'J.ToJSON' instance were modified to no longer always return objects
parameterizedQueryHashListToObject :: ParameterizedQueryHashList -> J.Object
parameterizedQueryHashListToObject :: ParameterizedQueryHashList -> Object
parameterizedQueryHashListToObject =
  [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([(Key, Value)] -> Object)
-> (ParameterizedQueryHashList -> [(Key, Value)])
-> ParameterizedQueryHashList
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    -- when a non-graphql query is executed, or when the request fails,
    -- there are no hashes to log
    ParameterizedQueryHashList
PQHSetEmpty -> []
    -- when there's no batching of graphql queries, we log the parameterized query hash as a string
    PQHSetSingleton ParameterizedQueryHash
queryHash ->
      [(Key
"parameterized_query_hash", ParameterizedQueryHash -> Value
forall a. ToJSON a => a -> Value
J.toJSON ParameterizedQueryHash
queryHash)]
    -- when there's a batch of graphql queries (even if the batch contains only one request),
    -- we log the parameterized query hashes of every request in a list
    PQHSetBatched [ParameterizedQueryHash]
queryHashes ->
      [(Key
"parameterized_query_hash", [ParameterizedQueryHash] -> Value
forall a. ToJSON a => a -> Value
J.toJSON [ParameterizedQueryHash]
queryHashes)]

newtype ParameterizedQueryHash = ParameterizedQueryHash {ParameterizedQueryHash -> ByteString
unParamQueryHash :: B.ByteString}
  deriving (Int -> ParameterizedQueryHash -> ShowS
[ParameterizedQueryHash] -> ShowS
ParameterizedQueryHash -> String
(Int -> ParameterizedQueryHash -> ShowS)
-> (ParameterizedQueryHash -> String)
-> ([ParameterizedQueryHash] -> ShowS)
-> Show ParameterizedQueryHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParameterizedQueryHash -> ShowS
showsPrec :: Int -> ParameterizedQueryHash -> ShowS
$cshow :: ParameterizedQueryHash -> String
show :: ParameterizedQueryHash -> String
$cshowList :: [ParameterizedQueryHash] -> ShowS
showList :: [ParameterizedQueryHash] -> ShowS
Show, ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
(ParameterizedQueryHash -> ParameterizedQueryHash -> Bool)
-> (ParameterizedQueryHash -> ParameterizedQueryHash -> Bool)
-> Eq ParameterizedQueryHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
== :: ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
$c/= :: ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
/= :: ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
Eq, Eq ParameterizedQueryHash
Eq ParameterizedQueryHash
-> (ParameterizedQueryHash -> ParameterizedQueryHash -> Ordering)
-> (ParameterizedQueryHash -> ParameterizedQueryHash -> Bool)
-> (ParameterizedQueryHash -> ParameterizedQueryHash -> Bool)
-> (ParameterizedQueryHash -> ParameterizedQueryHash -> Bool)
-> (ParameterizedQueryHash -> ParameterizedQueryHash -> Bool)
-> (ParameterizedQueryHash
    -> ParameterizedQueryHash -> ParameterizedQueryHash)
-> (ParameterizedQueryHash
    -> ParameterizedQueryHash -> ParameterizedQueryHash)
-> Ord ParameterizedQueryHash
ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
ParameterizedQueryHash -> ParameterizedQueryHash -> Ordering
ParameterizedQueryHash
-> ParameterizedQueryHash -> ParameterizedQueryHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ParameterizedQueryHash -> ParameterizedQueryHash -> Ordering
compare :: ParameterizedQueryHash -> ParameterizedQueryHash -> Ordering
$c< :: ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
< :: ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
$c<= :: ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
<= :: ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
$c> :: ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
> :: ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
$c>= :: ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
>= :: ParameterizedQueryHash -> ParameterizedQueryHash -> Bool
$cmax :: ParameterizedQueryHash
-> ParameterizedQueryHash -> ParameterizedQueryHash
max :: ParameterizedQueryHash
-> ParameterizedQueryHash -> ParameterizedQueryHash
$cmin :: ParameterizedQueryHash
-> ParameterizedQueryHash -> ParameterizedQueryHash
min :: ParameterizedQueryHash
-> ParameterizedQueryHash -> ParameterizedQueryHash
Ord)

instance Hashable ParameterizedQueryHash where
  hashWithSalt :: Int -> ParameterizedQueryHash -> Int
hashWithSalt Int
salt = Int -> ByteString -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (ByteString -> Int)
-> (ParameterizedQueryHash -> ByteString)
-> ParameterizedQueryHash
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterizedQueryHash -> ByteString
unParamQueryHash

instance J.ToJSON ParameterizedQueryHash where
  toJSON :: ParameterizedQueryHash -> Value
toJSON = Text -> Value
J.String (Text -> Value)
-> (ParameterizedQueryHash -> Text)
-> ParameterizedQueryHash
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
bsToTxt (ByteString -> Text)
-> (ParameterizedQueryHash -> ByteString)
-> ParameterizedQueryHash
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterizedQueryHash -> ByteString
unParamQueryHash

normalizeSelectionSet :: G.SelectionSet G.NoFragments Variable -> G.SelectionSet G.NoFragments Void
normalizeSelectionSet :: SelectionSet NoFragments Variable -> SelectionSet NoFragments Void
normalizeSelectionSet = (Selection NoFragments Variable -> SelectionSet NoFragments Void
normalizeSelection (Selection NoFragments Variable -> SelectionSet NoFragments Void)
-> SelectionSet NoFragments Variable
-> SelectionSet NoFragments Void
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
  where
    normalizeSelection :: G.Selection G.NoFragments Variable -> G.SelectionSet G.NoFragments Void
    normalizeSelection :: Selection NoFragments Variable -> SelectionSet NoFragments Void
normalizeSelection (G.SelectionField Field NoFragments Variable
fld) = Selection NoFragments Void -> SelectionSet NoFragments Void
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selection NoFragments Void -> SelectionSet NoFragments Void)
-> Selection NoFragments Void -> SelectionSet NoFragments Void
forall a b. (a -> b) -> a -> b
$ Field NoFragments Void -> Selection NoFragments Void
forall (frag :: * -> *) var. Field frag var -> Selection frag var
G.SelectionField (Field NoFragments Variable -> Field NoFragments Void
normalizeField Field NoFragments Variable
fld)
    normalizeSelection (G.SelectionInlineFragment (G.InlineFragment Maybe Name
_ [Directive Variable]
_ SelectionSet NoFragments Variable
selSet)) =
      SelectionSet NoFragments Variable -> SelectionSet NoFragments Void
normalizeSelectionSet SelectionSet NoFragments Variable
selSet

    normalizeField :: Field NoFragments Variable -> Field NoFragments Void
normalizeField (G.Field Maybe Name
_alias Name
name HashMap Name (Value Variable)
args [Directive Variable]
_directives SelectionSet NoFragments Variable
selSet) =
      Maybe Name
-> Name
-> HashMap Name (Value Void)
-> [Directive Void]
-> SelectionSet NoFragments Void
-> Field NoFragments Void
forall (frag :: * -> *) var.
Maybe Name
-> Name
-> HashMap Name (Value var)
-> [Directive var]
-> SelectionSet frag var
-> Field frag var
G.Field Maybe Name
forall a. Maybe a
Nothing Name
name ((Value Variable -> Value Void)
-> HashMap Name (Value Variable) -> HashMap Name (Value Void)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map Value Variable -> Value Void
normalizeValue HashMap Name (Value Variable)
args) [Directive Void]
forall a. Monoid a => a
mempty (SelectionSet NoFragments Void -> Field NoFragments Void)
-> SelectionSet NoFragments Void -> Field NoFragments Void
forall a b. (a -> b) -> a -> b
$ SelectionSet NoFragments Variable -> SelectionSet NoFragments Void
normalizeSelectionSet SelectionSet NoFragments Variable
selSet

    normalizeConstValue :: G.Value Void -> G.Value Void
    normalizeConstValue :: Value Void -> Value Void
normalizeConstValue = \case
      Value Void
G.VNull -> Value Void
forall var. Value var
G.VNull
      G.VInt Integer
_ -> Value Void
forall var. Value var
G.VNull
      G.VFloat Scientific
_ -> Value Void
forall var. Value var
G.VNull
      G.VString Text
_ -> Value Void
forall var. Value var
G.VNull
      G.VBoolean Bool
_ -> Value Void
forall var. Value var
G.VNull
      G.VEnum EnumValue
_ -> Value Void
forall var. Value var
G.VNull
      G.VList [Value Void]
l -> [Value Void] -> Value Void
forall var. [Value var] -> Value var
G.VList ([Value Void] -> Value Void) -> [Value Void] -> Value Void
forall a b. (a -> b) -> a -> b
$ (Value Void -> Value Void) -> [Value Void] -> [Value Void]
forall a b. (a -> b) -> [a] -> [b]
map Value Void -> Value Void
normalizeConstValue [Value Void]
l
      G.VObject HashMap Name (Value Void)
obj -> HashMap Name (Value Void) -> Value Void
forall var. HashMap Name (Value var) -> Value var
G.VObject (HashMap Name (Value Void) -> Value Void)
-> HashMap Name (Value Void) -> Value Void
forall a b. (a -> b) -> a -> b
$ (Value Void -> Value Void)
-> HashMap Name (Value Void) -> HashMap Name (Value Void)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map Value Void -> Value Void
normalizeConstValue HashMap Name (Value Void)
obj

    jsonToNormalizedGQLVal :: J.Value -> G.Value Void
    jsonToNormalizedGQLVal :: Value -> Value Void
jsonToNormalizedGQLVal = \case
      Value
J.Null -> Value Void
forall var. Value var
G.VNull
      J.Bool Bool
_ -> Value Void
forall var. Value var
G.VNull
      J.String Text
_ -> Value Void
forall var. Value var
G.VNull
      J.Number Scientific
_ -> Value Void
forall var. Value var
G.VNull
      J.Array Array
l -> [Value Void] -> Value Void
forall var. [Value var] -> Value var
G.VList ([Value Void] -> Value Void) -> [Value Void] -> Value Void
forall a b. (a -> b) -> a -> b
$ Value -> Value Void
jsonToNormalizedGQLVal (Value -> Value Void) -> [Value] -> [Value Void]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
l
      J.Object Object
vals ->
        HashMap Name (Value Void) -> Value Void
forall var. HashMap Name (Value var) -> Value var
G.VObject
          (HashMap Name (Value Void) -> Value Void)
-> HashMap Name (Value Void) -> Value Void
forall a b. (a -> b) -> a -> b
$
          -- FIXME(#3479): THIS WILL CREATE INVALID GRAPHQL OBJECTS
          [(Name, Value Void)] -> HashMap Name (Value Void)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
            [ (Name
name, Value -> Value Void
jsonToNormalizedGQLVal Value
val)
              | (Key
key, Value
val) <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
vals,
                Name
name <- Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Text -> Maybe Name
G.mkName (Key -> Text
K.toText Key
key))
            ]

    normalizeValue :: G.Value Variable -> G.Value Void
    normalizeValue :: Value Variable -> Value Void
normalizeValue = \case
      Value Variable
G.VNull -> Value Void
forall var. Value var
G.VNull
      G.VInt Integer
_ -> Value Void
forall var. Value var
G.VNull
      G.VFloat Scientific
_ -> Value Void
forall var. Value var
G.VNull
      G.VString Text
_ -> Value Void
forall var. Value var
G.VNull
      G.VBoolean Bool
_ -> Value Void
forall var. Value var
G.VNull
      G.VEnum EnumValue
_ -> Value Void
forall var. Value var
G.VNull
      G.VList [Value Variable]
l -> [Value Void] -> Value Void
forall var. [Value var] -> Value var
G.VList ([Value Void] -> Value Void) -> [Value Void] -> Value Void
forall a b. (a -> b) -> a -> b
$ (Value Variable -> Value Void) -> [Value Variable] -> [Value Void]
forall a b. (a -> b) -> [a] -> [b]
map Value Variable -> Value Void
normalizeValue [Value Variable]
l
      G.VObject HashMap Name (Value Variable)
obj -> HashMap Name (Value Void) -> Value Void
forall var. HashMap Name (Value var) -> Value var
G.VObject (HashMap Name (Value Void) -> Value Void)
-> HashMap Name (Value Void) -> Value Void
forall a b. (a -> b) -> a -> b
$ (Value Variable -> Value Void)
-> HashMap Name (Value Variable) -> HashMap Name (Value Void)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map Value Variable -> Value Void
normalizeValue HashMap Name (Value Variable)
obj
      -- Pretend that variables without values are just nulls.
      G.VVariable (Variable VariableInfo
_info GType
_type Maybe (InputValue Void)
Nothing) -> Value Void
forall var. Value var
G.VNull
      G.VVariable (Variable VariableInfo
_info GType
_type (Just InputValue Void
value)) ->
        case InputValue Void
value of
          GraphQLValue Value Void
val -> Value Void -> Value Void
normalizeConstValue Value Void
val
          JSONValue Value
v -> Value -> Value Void
jsonToNormalizedGQLVal Value
v

calculateParameterizedQueryHash :: G.SelectionSet G.NoFragments Variable -> ParameterizedQueryHash
calculateParameterizedQueryHash :: SelectionSet NoFragments Variable -> ParameterizedQueryHash
calculateParameterizedQueryHash = ByteString -> ParameterizedQueryHash
ParameterizedQueryHash (ByteString -> ParameterizedQueryHash)
-> (SelectionSet NoFragments Variable -> ByteString)
-> SelectionSet NoFragments Variable
-> ParameterizedQueryHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a. ToJSON a => a -> ByteString
cryptoHash (Text -> ByteString)
-> (SelectionSet NoFragments Variable -> Text)
-> SelectionSet NoFragments Variable
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Text.run (Builder -> Text)
-> (SelectionSet NoFragments Variable -> Builder)
-> SelectionSet NoFragments Variable
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionSet NoFragments Void -> Builder
forall (frag :: * -> *) var a.
(Print (frag var), Print var, Printer a) =>
SelectionSet frag var -> a
G.selectionSet (SelectionSet NoFragments Void -> Builder)
-> (SelectionSet NoFragments Variable
    -> SelectionSet NoFragments Void)
-> SelectionSet NoFragments Variable
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionSet NoFragments Variable -> SelectionSet NoFragments Void
normalizeSelectionSet

mkUnsafeParameterizedQueryHash :: Text -> ParameterizedQueryHash
mkUnsafeParameterizedQueryHash :: Text -> ParameterizedQueryHash
mkUnsafeParameterizedQueryHash = ByteString -> ParameterizedQueryHash
ParameterizedQueryHash (ByteString -> ParameterizedQueryHash)
-> (Text -> ByteString) -> Text -> ParameterizedQueryHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
txtToBs