server: Introduce option to add query field in http-log only on errors

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/11029 GitOrigin-RevId: f5c8aa1b81d67b84030215cb68b3bb9ee6021087
2024-12-14 17:02:49 +03:00 · 2024-09-18 14:49:34 +05:30 · 2024-09-18 14:49:34 +05:30 · f4aafb234d
commit f4aafb234d
parent 0c52ca1d2e
10 changed files with 70 additions and 16 deletions
--- a/server/lib/test-harness/src/Harness/Constants.hs
+++ b/server/lib/test-harness/src/Harness/Constants.hs
@ -55,7 +55,7 @@ import Hasura.Server.Init
    ServeOptions (..),
  )
 import Hasura.Server.Init qualified as Init
-import Hasura.Server.Logging (MetadataQueryLoggingMode (MetadataQueryLoggingDisabled))
+import Hasura.Server.Logging (HttpLogQueryOnlyOnError (HttpLogQueryOnlyOnErrorDisabled), MetadataQueryLoggingMode (MetadataQueryLoggingDisabled))
 import Hasura.Server.Types
  ( ApolloFederationStatus (ApolloFederationDisabled),
    EventingMode (EventingEnabled),
@ -321,6 +321,7 @@ serveOptions =
      soEventingMode = EventingEnabled,
      soReadOnlyMode = ReadOnlyModeDisabled,
      soEnableMetadataQueryLogging = MetadataQueryLoggingDisabled,
+      soHttpLogQueryOnlyOnError = HttpLogQueryOnlyOnErrorDisabled,
      soDefaultNamingConvention = Init._default Init.defaultNamingConventionOption,
      soExtensionsSchema = ExtensionsSchema "public",
      soMetadataDefaults = emptyMetadataDefaults,
--- a/server/src-lib/Hasura/App.hs
+++ b/server/src-lib/Hasura/App.hs
@ -477,7 +477,7 @@ initialiseAppEnv env BasicConnectionInfo {..} serveOptions@ServeOptions {..} liv
          appEnvMetadataVersionRef = metaVersionRef,
          appEnvInstanceId = instanceId,
          appEnvEnableMaintenanceMode = soEnableMaintenanceMode,
-          appEnvLoggingSettings = LoggingSettings soEnabledLogTypes soEnableMetadataQueryLogging,
+          appEnvLoggingSettings = LoggingSettings soEnabledLogTypes soEnableMetadataQueryLogging soHttpLogQueryOnlyOnError,
          appEnvEventingMode = soEventingMode,
          appEnvEnableReadOnlyMode = soReadOnlyMode,
          appEnvServerMetrics = serverMetrics,
--- a/server/src-lib/Hasura/Server/Init.hs
+++ b/server/src-lib/Hasura/Server/Init.hs
@ -211,6 +211,9 @@ mkServeOptions sor@ServeOptionsRaw {..} = do
  soEnableMetadataQueryLogging <- case rsoEnableMetadataQueryLoggingEnv of
    Server.Logging.MetadataQueryLoggingDisabled -> withOptionDefault Nothing enableMetadataQueryLoggingOption
    metadataQueryLoggingEnabled -> pure metadataQueryLoggingEnabled
+  soHttpLogQueryOnlyOnError <- case rsoHttpLogQueryOnlyOnError of
+    Server.Logging.HttpLogQueryOnlyOnErrorDisabled -> withOptionDefault Nothing httpLogQueryOnlyOnErrorOption
+    httpLogQueryOnlyOnError -> pure httpLogQueryOnlyOnError
  soDefaultNamingConvention <- withOptionDefault rsoDefaultNamingConvention defaultNamingConventionOption
  soMetadataDefaults <- withOptionDefault rsoMetadataDefaults metadataDefaultsOption
  soExtensionsSchema <- withOptionDefault rsoExtensionsSchema metadataDBExtensionsSchemaOption
--- a/server/src-lib/Hasura/Server/Init/Arg/Command/Serve.hs
+++ b/server/src-lib/Hasura/Server/Init/Arg/Command/Serve.hs
@ -59,6 +59,7 @@ module Hasura.Server.Init.Arg.Command.Serve
    gracefulShutdownOption,
    webSocketConnectionInitTimeoutOption,
    enableMetadataQueryLoggingOption,
+    httpLogQueryOnlyOnErrorOption,
    defaultNamingConventionOption,
    metadataDBExtensionsSchemaOption,
    parseMetadataDefaults,
@ -158,6 +159,7 @@ serveCommandParser =
    <*> parseGracefulShutdownTimeout
    <*> parseWebSocketConnectionInitTimeout
    <*> parseEnableMetadataQueryLogging
+    <*> parseHttpLogQueryOnlyOnError
    <*> parseDefaultNamingConvention
    <*> parseExtensionsSchema
    <*> parseMetadataDefaults
@ -1165,6 +1167,22 @@ enableMetadataQueryLoggingOption =
      Config._helpMessage = "Enables the query field in http-logs for metadata queries (default: false)"
    }

+parseHttpLogQueryOnlyOnError :: Opt.Parser Server.Logging.HttpLogQueryOnlyOnError
+parseHttpLogQueryOnlyOnError =
+  fmap (bool Server.Logging.HttpLogQueryOnlyOnErrorDisabled Server.Logging.HttpLogQueryOnlyOnErrorEnabled)
+    $ Opt.switch
+      ( Opt.long "http-log-query-only-on-error"
+          <> Opt.help (Config._helpMessage httpLogQueryOnlyOnErrorOption)
+      )
+
+httpLogQueryOnlyOnErrorOption :: Config.Option Server.Logging.HttpLogQueryOnlyOnError
+httpLogQueryOnlyOnErrorOption =
+  Config.Option
+    { Config._default = Server.Logging.HttpLogQueryOnlyOnErrorDisabled,
+      Config._envVar = "HASURA_GRAPHQL_HTTP_LOG_QUERY_ONLY_ON_ERROR",
+      Config._helpMessage = "Only add query to http log on error (default: false)"
+    }
+
 -- TODO(SOLOMON): The defaulting behavior for this occurs inside the Engine. In
 -- an isolated PR we should move that defaulting in the parsing stage.
 parseDefaultNamingConvention :: Opt.Parser (Maybe NC.NamingCase)
--- a/server/src-lib/Hasura/Server/Init/Config.hs
+++ b/server/src-lib/Hasura/Server/Init/Config.hs
@ -321,6 +321,7 @@ data ServeOptionsRaw impl = ServeOptionsRaw
    rsoGracefulShutdownTimeout :: Maybe (Refined NonNegative Seconds),
    rsoWebSocketConnectionInitTimeout :: Maybe WSConnectionInitTimeout,
    rsoEnableMetadataQueryLoggingEnv :: Server.Logging.MetadataQueryLoggingMode,
+    rsoHttpLogQueryOnlyOnError :: Server.Logging.HttpLogQueryOnlyOnError,
    -- | stores global default naming convention
    rsoDefaultNamingConvention :: Maybe NamingCase,
    rsoExtensionsSchema :: Maybe MonadTx.ExtensionsSchema,
@ -635,6 +636,7 @@ data ServeOptions impl = ServeOptions
    -- | See note '$readOnlyMode'
    soReadOnlyMode :: Server.Types.ReadOnlyMode,
    soEnableMetadataQueryLogging :: Server.Logging.MetadataQueryLoggingMode,
+    soHttpLogQueryOnlyOnError :: Server.Logging.HttpLogQueryOnlyOnError,
    soDefaultNamingConvention :: NamingCase,
    soExtensionsSchema :: MonadTx.ExtensionsSchema,
    soMetadataDefaults :: MetadataDefaults,
--- a/server/src-lib/Hasura/Server/Init/Env.hs
+++ b/server/src-lib/Hasura/Server/Init/Env.hs
@ -272,6 +272,9 @@ instance FromEnv (Server.Types.MaintenanceMode ()) where
 instance FromEnv Server.Logging.MetadataQueryLoggingMode where
  fromEnv = fmap (bool Server.Logging.MetadataQueryLoggingDisabled Server.Logging.MetadataQueryLoggingEnabled) . fromEnv @Bool

+instance FromEnv Server.Logging.HttpLogQueryOnlyOnError where
+  fromEnv = fmap (bool Server.Logging.HttpLogQueryOnlyOnErrorDisabled Server.Logging.HttpLogQueryOnlyOnErrorEnabled) . fromEnv @Bool
+
 instance FromEnv Query.TxIsolation where
  fromEnv = Utils.readIsoLevel

--- a/server/src-lib/Hasura/Server/Init/Logging.hs
+++ b/server/src-lib/Hasura/Server/Init/Logging.hs
@ -120,7 +120,8 @@ serveOptsToLog so =
          "events_fetch_batch_size" .= Config.soEventsFetchBatchSize so,
          "graceful_shutdown_timeout" .= Config.soGracefulShutdownTimeout so,
          "websocket_connection_init_timeout" .= show (Config.soWebSocketConnectionInitTimeout so),
-          "enable_metadata_query_logging" .= Config.soEnableMetadataQueryLogging so
+          "enable_metadata_query_logging" .= Config.soEnableMetadataQueryLogging so,
+          "http_log_query_only_on_error" .= Config.soHttpLogQueryOnlyOnError so
        ]

 mkGenericLog :: (ToJSON a) => Logging.LogLevel -> Text -> a -> Server.Logging.StartupLog
--- a/server/src-lib/Hasura/Server/Logging.hs
+++ b/server/src-lib/Hasura/Server/Logging.hs
@ -25,6 +25,7 @@ module Hasura.Server.Logging
    buildHttpLogMetadata,
    emptyHttpLogMetadata,
    MetadataQueryLoggingMode (..),
+    HttpLogQueryOnlyOnError (..),
    LoggingSettings (..),
    SchemaSyncThreadType (..),
    SchemaSyncLog (..),
@ -254,13 +255,28 @@ instance J.ToJSON MetadataQueryLoggingMode where
    MetadataQueryLoggingEnabled -> J.Bool True
    MetadataQueryLoggingDisabled -> J.Bool False

+data HttpLogQueryOnlyOnError = HttpLogQueryOnlyOnErrorEnabled | HttpLogQueryOnlyOnErrorDisabled
+  deriving (Show, Eq)
+
+instance J.FromJSON HttpLogQueryOnlyOnError where
+  parseJSON =
+    J.withBool "HttpLogQueryOnlyOnError"
+      $ pure
+      . bool HttpLogQueryOnlyOnErrorDisabled HttpLogQueryOnlyOnErrorEnabled
+
+instance J.ToJSON HttpLogQueryOnlyOnError where
+  toJSON = \case
+    HttpLogQueryOnlyOnErrorEnabled -> J.Bool True
+    HttpLogQueryOnlyOnErrorDisabled -> J.Bool False
+
 -- | Setting used to control the information in logs
 data LoggingSettings = LoggingSettings
  { -- | this is only required for the short-term fix in https://github.com/hasura/graphql-engine-mono/issues/1770
    -- See Note [Disable query printing when query-log is disabled]
    _lsEnabledLogTypes :: HashSet (EngineLogType Hasura),
    -- See Note [Disable query printing for metadata queries]
-    _lsMetadataQueryLoggingMode :: MetadataQueryLoggingMode
+    _lsMetadataQueryLoggingMode :: MetadataQueryLoggingMode,
+    _lsHttpLogQueryOnlyOnError :: HttpLogQueryOnlyOnError
  }
  deriving (Eq)

@ -470,9 +486,16 @@ instance J.ToJSON HttpLogContext where
  toJSON = J.genericToJSON hasuraJSON {J.omitNothingFields = True}
  toEncoding = J.genericToEncoding hasuraJSON {J.omitNothingFields = True}

+data RequestStatus
+  = RequestStatusSuccess
+  | RequestStatusError
+  deriving (Eq, Show)
+
 -- | Check if the 'query' field should be included in the http-log
-isQueryIncludedInLogs :: Text -> LoggingSettings -> Bool
-isQueryIncludedInLogs urlPath LoggingSettings {..}
+isQueryIncludedInLogs :: RequestStatus -> Text -> LoggingSettings -> Bool
+isQueryIncludedInLogs requestStatus urlPath LoggingSettings {..}
+  -- if HttpLogQueryOnlyOnError is enabled, log the query when request is failed
+  | _lsHttpLogQueryOnlyOnError == HttpLogQueryOnlyOnErrorEnabled = requestStatus == RequestStatusError
  -- See Note [Disable query printing for metadata queries]
  | isQueryLogEnabled && isMetadataRequest = _lsMetadataQueryLoggingMode == MetadataQueryLoggingEnabled
  -- See Note [Disable query printing when query-log is disabled]
@ -485,9 +508,9 @@ isQueryIncludedInLogs urlPath LoggingSettings {..}

 -- | Add the 'query' field to the http-log if `MetadataQueryLoggingMode`
 -- is set to `MetadataQueryLoggingEnabled` else only adds the `query.type` field.
-addQuery :: Maybe J.Value -> Text -> LoggingSettings -> Maybe J.Value
-addQuery parsedReq path loggingSettings =
-  if isQueryIncludedInLogs path loggingSettings
+addQuery :: RequestStatus -> Maybe J.Value -> Text -> LoggingSettings -> Maybe J.Value
+addQuery requestStatus parsedReq path loggingSettings =
+  if isQueryIncludedInLogs requestStatus path loggingSettings
    then parsedReq
    else Just $ J.object ["type" J..= (fmap (^? key "type" . _String)) parsedReq]

@ -527,7 +550,7 @@ mkHttpAccessLogContext userInfoM loggingSettings reqId req (_, parsedReq) uncomp
            olRequestReadTime = Seconds . fst <$> mTiming,
            olQueryExecutionTime = Seconds . snd <$> mTiming,
            olRequestMode = batching,
-            olQuery = addQuery parsedReq (hlPath http) loggingSettings,
+            olQuery = addQuery RequestStatusSuccess parsedReq (hlPath http) loggingSettings,
            olRawQuery = Nothing,
            olError = Nothing
          }
@ -542,13 +565,13 @@ mkHttpAccessLogContext userInfoM loggingSettings reqId req (_, parsedReq) uncomp
                            GQLQueryOperationSuccess (GQLQueryOperationSuccessLog {..}) ->
                              BatchOperationSuccess
                                $ BatchOperationSuccessLog
-                                  (addQuery parsedReq (hlPath http) loggingSettings)
+                                  (addQuery RequestStatusSuccess parsedReq (hlPath http) loggingSettings)
                                  gqolResponseSize
                                  (convertDuration gqolQueryExecutionTime)
                            GQLQueryOperationError (GQLQueryOperationErrorLog {..}) ->
                              BatchOperationError
                                $ BatchOperationErrorLog
-                                  (addQuery parsedReq (hlPath http) loggingSettings)
+                                  (addQuery RequestStatusError parsedReq (hlPath http) loggingSettings)
                                  gqelError
                        )
                        opLogs
@ -571,7 +594,8 @@ mkHttpErrorLogContext ::
  [HTTP.Header] ->
  HttpLogContext
 mkHttpErrorLogContext userInfoM loggingSettings reqId waiReq (reqBody, parsedReq) err mTiming compressTypeM headers =
-  let http =
+  let requestStatus = RequestStatusError
+      http =
        HttpInfoLog
          { hlStatus = qeStatus err,
            hlMethod = bsToTxt $ Wai.requestMethod waiReq,
@ -590,7 +614,7 @@ mkHttpErrorLogContext userInfoM loggingSettings reqId waiReq (reqBody, parsedReq
            olUncompressedResponseSize = responseSize,
            olRequestReadTime = Seconds . fst <$> mTiming,
            olQueryExecutionTime = Seconds . snd <$> mTiming,
-            olQuery = addQuery parsedReq (hlPath http) loggingSettings,
+            olQuery = addQuery requestStatus parsedReq (hlPath http) loggingSettings,
            -- if parsedReq is Nothing, add the raw query
            olRawQuery = maybe (reqToLog $ Just $ bsToTxt $ BL.toStrict reqBody) (const Nothing) parsedReq,
            olError = Just err,
@ -598,7 +622,7 @@ mkHttpErrorLogContext userInfoM loggingSettings reqId waiReq (reqBody, parsedReq
          }

      reqToLog :: Maybe a -> Maybe a
-      reqToLog req = if (isQueryIncludedInLogs (hlPath http) loggingSettings) then req else Nothing
+      reqToLog req = if (isQueryIncludedInLogs requestStatus (hlPath http) loggingSettings) then req else Nothing
   in HttpLogContext http op reqId Nothing -- Batched operation logs are always reported in logHttpSuccess even if there are errors

 data HttpLogLine = HttpLogLine
--- a/server/src-test/Hasura/Server/InitSpec.hs
+++ b/server/src-test/Hasura/Server/InitSpec.hs
@ -91,6 +91,7 @@ emptyServeOptionsRaw =
      rsoGracefulShutdownTimeout = Nothing,
      rsoWebSocketConnectionInitTimeout = Nothing,
      rsoEnableMetadataQueryLoggingEnv = Logging.MetadataQueryLoggingDisabled,
+      rsoHttpLogQueryOnlyOnError = Logging.HttpLogQueryOnlyOnErrorDisabled,
      rsoDefaultNamingConvention = Nothing,
      rsoExtensionsSchema = Nothing,
      rsoMetadataDefaults = Nothing,
--- a/server/test-postgres/Constants.hs
+++ b/server/test-postgres/Constants.hs
@ -24,7 +24,7 @@ import Hasura.Server.Init
    ServeOptions (..),
  )
 import Hasura.Server.Init qualified as Init
-import Hasura.Server.Logging (MetadataQueryLoggingMode (MetadataQueryLoggingDisabled))
+import Hasura.Server.Logging (HttpLogQueryOnlyOnError (HttpLogQueryOnlyOnErrorDisabled), MetadataQueryLoggingMode (MetadataQueryLoggingDisabled))
 import Hasura.Server.Types
  ( ApolloFederationStatus (ApolloFederationDisabled),
    EventingMode (EventingEnabled),
@ -89,6 +89,7 @@ serveOptions =
      soEventingMode = EventingEnabled,
      soReadOnlyMode = ReadOnlyModeDisabled,
      soEnableMetadataQueryLogging = MetadataQueryLoggingDisabled,
+      soHttpLogQueryOnlyOnError = HttpLogQueryOnlyOnErrorDisabled,
      soDefaultNamingConvention = Init._default Init.defaultNamingConventionOption,
      soExtensionsSchema = ExtensionsSchema "public",
      soMetadataDefaults = emptyMetadataDefaults,