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

PR-URL: hasura/graphql-engine-mono#11029
GitOrigin-RevId: f5c8aa1b81d67b84030215cb68b3bb9ee6021087

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,

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,

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

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)

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,

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
 

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

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,15 +614,15 @@ 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,
             olRequestMode = RequestModeError
           }
 
       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

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,

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,