pro, server: improve parameterised query hash handling for batched requests (fix #1767)

https://github.com/hasura/graphql-engine-mono/pull/1768

GitOrigin-RevId: 11615408ee2fb097e68ee4a641e5dc46c1d28795

CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## Next release
 (Add entries below in the order of server, console, cli, docs, others)
+- server: fix http-log bug where batches with only one request emitted the parameterised query hash as a string instead of in a singleton array
 - console: add template gallery
 - server: subscriptions now validate that all session variables are properly set (#7111)
 

server/src-lib/Hasura/GraphQL/ParameterizedQueryHash.hs

@@ -62,7 +62,8 @@ module Hasura.GraphQL.ParameterizedQueryHash
   , mkUnsafeParameterizedQueryHash
   , unParamQueryHash
   , ParameterizedQueryHash
-  )
+  , ParameterizedQueryHashList(..)
+  ,parameterizedQueryHashListToObject)
 where
 
 import           Hasura.Prelude
@@ -78,6 +79,49 @@ import           Hasura.GraphQL.Parser          (InputValue (..), Variable (..))
 
 import           Hasura.Server.Utils            (cryptoHash)
 
+-- | 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
+  = PQHSetEmpty
+  -- ^ an empty query hash set, either for an operation that does not produce
+  -- query hashes, or due to failure in operation execution
+  | PQHSetSingleton !ParameterizedQueryHash
+  -- ^ a query hash set consisting of a single element, corresponding to e.g.
+  -- a single (non-batched) graphql request
+  | PQHSetBatched ![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
+  deriving (Show, 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 = Map.fromList . \case
+  -- when a non-graphql query is executed, or when the request fails,
+  -- there are no hashes to log
+  PQHSetEmpty -> []
+  -- when there's no batching of graphql queries, we log the parameterized query hash as a string
+  PQHSetSingleton queryHash ->
+    [("parameterized_query_hash" , J.toJSON 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 queryHashes ->
+    [("parameterized_query_hash" , J.toJSON queryHashes)]
+
+
 newtype ParameterizedQueryHash
   = ParameterizedQueryHash { unParamQueryHash :: B.ByteString }
   deriving (Show, Eq)

server/src-lib/Hasura/GraphQL/Transport/HTTP.hs

@@ -535,7 +535,7 @@ runGQBatched env logger reqId responseErrorsConfig userInfo ipAddress reqHdrs qu
   case query of
     GQLSingleRequest req -> do
       (parameterizedQueryHash, httpResp) <- runGQ env logger reqId userInfo ipAddress reqHdrs queryType req
-      let httpLoggingMetadata = buildHttpLogMetadata @m [parameterizedQueryHash] $ Just L.RequestSingle
+      let httpLoggingMetadata = buildHttpLogMetadata @m (PQHSetSingleton parameterizedQueryHash) L.RequestModeSingle
       pure (httpLoggingMetadata, snd <$> httpResp)
     GQLBatchedReqs reqs -> do
       -- It's unclear what we should do if we receive multiple
@@ -547,7 +547,7 @@ runGQBatched env logger reqId responseErrorsConfig userInfo ipAddress reqHdrs qu
             . encJFromList
             . map (either (encJFromJValue . encodeGQErr includeInternal) _hrBody)
       responses <- traverse (try . (fmap . fmap . fmap) snd . runGQ env logger reqId userInfo ipAddress reqHdrs queryType) reqs
-      let httpLoggingMetadata = buildHttpLogMetadata @m (rights $ map (fmap fst) responses) $ Just L.RequestBatched
+      let httpLoggingMetadata = buildHttpLogMetadata @m (PQHSetBatched $ rights $ map (fmap fst) responses) L.RequestModeBatched
       pure (httpLoggingMetadata, removeHeaders (map (fmap snd) responses))
   where
     try = flip catchError (pure . Left) . fmap Right

server/src-lib/Hasura/Server/Logging.hs

@@ -3,7 +3,7 @@
 module Hasura.Server.Logging
   ( StartupLog(..)
   , PGLog(..)
-  , RequestBatching(..)
+  , RequestMode(..)
   , mkInconsMetadataLog
   , mkHttpAccessLogContext
   , mkHttpErrorLogContext
@@ -133,15 +133,26 @@ instance ToJSON WebHookLog where
            , "message" .= whlMessage whl
            ]
 
-data RequestBatching = RequestBatched | RequestSingle
+-- | whether a request is executed in batched mode or not
+data RequestMode
+  = RequestModeBatched
+  -- ^ this request is batched
+  | RequestModeSingle
+  -- ^ this is a single request
+  | RequestModeNonBatchable
+  -- ^ this request is of a kind for which batching is not done or does not make sense
+  | RequestModeError
+  -- ^ the execution of this request failed
   deriving (Show, Eq)
 
-instance ToJSON RequestBatching where
+instance ToJSON RequestMode where
   toJSON = \case
-    RequestBatched -> "batched"
-    RequestSingle  -> "single"
+    RequestModeBatched      -> "batched"
+    RequestModeSingle       -> "single"
+    RequestModeNonBatchable -> "non-graphql"
+    RequestModeError        -> "error"
 
-newtype CommonHttpLogMetadata = CommonHttpLogMetadata {_chlmRequestType :: Maybe RequestBatching}
+newtype CommonHttpLogMetadata = CommonHttpLogMetadata {_chlmRequestMode :: RequestMode}
   deriving (Show, Eq)
 
 -- | The http-log metadata attached to HTTP requests running in the monad 'm', split into a
@@ -155,14 +166,14 @@ type HttpLogMetadata m = (CommonHttpLogMetadata, ExtraHttpLogMetadata m)
 buildHttpLogMetadata
   :: forall m
    . HttpLog m
-  => [ParameterizedQueryHash]
-  -> Maybe RequestBatching
+  => ParameterizedQueryHashList
+  -> RequestMode
   -> HttpLogMetadata m
 buildHttpLogMetadata xs rb = (CommonHttpLogMetadata rb, buildExtraHttpLogMetadata @m xs)
 
 -- | synonym for clarity, writing `emptyHttpLogMetadata @m` instead of `def @(HttpLogMetadata m)`
 emptyHttpLogMetadata :: forall m. HttpLog m => HttpLogMetadata m
-emptyHttpLogMetadata = (CommonHttpLogMetadata Nothing, emptyExtraHttpLogMetadata @m)
+emptyHttpLogMetadata = (CommonHttpLogMetadata RequestModeNonBatchable, emptyExtraHttpLogMetadata @m)
 
 
 {- Note [Disable query printing when query-log is disabled]
@@ -179,7 +190,7 @@ class Monad m => HttpLog m where
 
   emptyExtraHttpLogMetadata :: ExtraHttpLogMetadata m
 
-  buildExtraHttpLogMetadata :: [ParameterizedQueryHash] -> ExtraHttpLogMetadata m
+  buildExtraHttpLogMetadata :: ParameterizedQueryHashList -> ExtraHttpLogMetadata m
 
   logHttpError
     :: Logger Hasura
@@ -296,7 +307,7 @@ data OperationLog
   , olQuery              :: !(Maybe Value)
   , olRawQuery           :: !(Maybe Text)
   , olError              :: !(Maybe QErr)
-  , olRequestMode        :: !(Maybe RequestBatching)
+  , olRequestMode        :: !RequestMode
   } deriving (Show, Eq)
 
 $(deriveToJSON hasuraJSON{omitNothingFields = True} ''OperationLog)
@@ -320,7 +331,7 @@ mkHttpAccessLogContext
   -> Maybe (DiffTime, DiffTime)
   -> Maybe CompressionType
   -> [HTTP.Header]
-  -> Maybe RequestBatching
+  -> RequestMode
   -> HttpLogContext
 mkHttpAccessLogContext userInfoM enabledLogTypes reqId req (_, parsedReq) res mTiming compressTypeM headers batching =
   let http = HttpInfoLog
@@ -381,7 +392,7 @@ mkHttpErrorLogContext userInfoM enabledLogTypes reqId waiReq (reqBody, parsedReq
            -- if parsedReq is Nothing, add the raw query
            , olRawQuery           = maybe (reqToLog $ Just $ bsToTxt $ BL.toStrict reqBody) (const Nothing) parsedReq
            , olError              = Just err
-           , olRequestMode        = Nothing
+           , olRequestMode        = RequestModeError
            }
 
       -- See Note [Disable query printing when query-log is disabled]

server/src-lib/Hasura/Server/Rest.hs

@@ -19,6 +19,7 @@ import           Data.Aeson                             hiding (json)
 import           Data.Text.Extended
 
 import qualified Hasura.GraphQL.Execute                 as E
+import           Hasura.GraphQL.ParameterizedQueryHash  (ParameterizedQueryHashList (..))
 import qualified Hasura.GraphQL.Transport.HTTP          as GH
 import qualified Hasura.Tracing                         as Tracing
 import qualified Language.GraphQL.Draft.Syntax          as G
@@ -160,10 +161,10 @@ runCustomEndpoint env execCtx requestId userInfo reqHeaders ipAddress RestReques
           -- through to the /v1/graphql endpoint.
           (httpLoggingMetadata, handlerResp) <- flip runReaderT execCtx $ do
               (parameterizedQueryHash, resp) <- GH.runGQ env (E._ecxLogger execCtx) requestId userInfo ipAddress reqHeaders E.QueryHasura (mkPassthroughRequest queryx resolvedVariables)
-              let httpLogMetadata = buildHttpLogMetadata @m [parameterizedQueryHash] Nothing
+              let httpLogMetadata = buildHttpLogMetadata @m (PQHSetSingleton parameterizedQueryHash) RequestModeNonBatchable
               return (httpLogMetadata, fst <$> resp)
           case sequence handlerResp of
-            Just resp -> pure $ (httpLoggingMetadata, fmap encodeHTTPResp resp)
+            Just resp -> pure (httpLoggingMetadata, fmap encodeHTTPResp resp)
             -- a Nothing value here indicates a failure to parse the cached request from redis.
             -- TODO: Do we need an additional log message here?
             Nothing -> throw500 "An unexpected error occurred while fetching the data from the cache"