-- | Helpful functions and types for generating log statements and URIs during
-- Options fetching and merging.
module Hasura.Server.Init.Logging
  ( -- * URI/QueryParam Manipulation
    censorQuery,
    updateQuery,
    censorURI,

    -- * Log Construction
    mkGenericLog,
    connInfoToLog,
    serveOptsToLog,
    StartupTimeInfo (..),
  )
where

--------------------------------------------------------------------------------

import Data.Aeson (FromJSON, ToJSON, (.=))
import Data.Aeson qualified as J
import Data.ByteString.Char8 qualified as Char8
import Data.HashSet qualified as HashSet
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text.Encoding
import Database.PG.Query qualified as Query
import Hasura.Logging qualified as Logging
import Hasura.Prelude
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.Server.Auth qualified as Auth
import Hasura.Server.Init.Config qualified as Config
import Hasura.Server.Logging qualified as Server.Logging
import Network.HTTP.Types.URI qualified as URI
import Network.URI qualified as URI
import Network.WebSockets qualified as WebSockets

--------------------------------------------------------------------------------

censorQueryItem :: Text -> URI.QueryItem -> URI.QueryItem
censorQueryItem :: Text -> QueryItem -> QueryItem
censorQueryItem Text
sensitive (ByteString
key, Just ByteString
_) | ByteString
key ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> ByteString
Text.Encoding.encodeUtf8 Text
sensitive = (ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"...")
censorQueryItem Text
_ QueryItem
qi = QueryItem
qi

censorQuery :: Text -> URI.Query -> URI.Query
censorQuery :: Text -> Query -> Query
censorQuery Text
sensitive = (QueryItem -> QueryItem) -> Query -> Query
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> QueryItem -> QueryItem
censorQueryItem Text
sensitive)

updateQuery :: (URI.Query -> URI.Query) -> URI.URI -> URI.URI
updateQuery :: (Query -> Query) -> URI -> URI
updateQuery Query -> Query
f URI
uri =
  let queries :: Query
queries = ByteString -> Query
URI.parseQuery (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ String -> ByteString
Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ URI -> String
URI.uriQuery URI
uri
   in URI
uri {uriQuery :: String
URI.uriQuery = ByteString -> String
Char8.unpack (Bool -> Query -> ByteString
URI.renderQuery Bool
True (Query -> ByteString) -> Query -> ByteString
forall a b. (a -> b) -> a -> b
$ Query -> Query
f Query
queries)}

censorURI :: Text -> URI.URI -> URI.URI
censorURI :: Text -> URI -> URI
censorURI Text
sensitive URI
uri = (Query -> Query) -> URI -> URI
updateQuery (Text -> Query -> Query
censorQuery Text
sensitive) URI
uri

-- | Generate a 'StartupLog' from the Postgres 'ConnInfo'.
connInfoToLog :: Query.ConnInfo -> Server.Logging.StartupLog
connInfoToLog :: ConnInfo -> StartupLog
connInfoToLog ConnInfo
connInfo =
  LogLevel -> Text -> Value -> StartupLog
Server.Logging.StartupLog LogLevel
Logging.LevelInfo Text
"postgres_connection" Value
infoVal
  where
    Query.ConnInfo Int
retries ConnDetails
details = ConnInfo
connInfo
    infoVal :: Value
infoVal = case ConnDetails
details of
      Query.CDDatabaseURI ByteString
uri -> String -> Value
mkDBUriLog (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
bsToTxt ByteString
uri
      Query.CDOptions ConnOptions
co ->
        [Pair] -> Value
J.object
          [ Key
"host" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ConnOptions -> String
Query.connHost ConnOptions
co,
            Key
"port" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ConnOptions -> Int
Query.connPort ConnOptions
co,
            Key
"user" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ConnOptions -> String
Query.connUser ConnOptions
co,
            Key
"database" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ConnOptions -> String
Query.connDatabase ConnOptions
co,
            Key
"retries" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Int
retries
          ]

    mkDBUriLog :: String -> Value
mkDBUriLog String
uri =
      case URI -> String
forall a. Show a => a -> String
show (URI -> String) -> (URI -> URI) -> URI -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> URI -> URI
censorURI Text
"sslpassword" (URI -> String) -> Maybe URI -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe URI
URI.parseURI String
uri of
        Maybe String
Nothing ->
          [Pair] -> Value
J.object
            [Key
"error" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (String
"parsing database url failed" :: String)]
        Just String
s ->
          [Pair] -> Value
J.object
            [ Key
"retries" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Int
retries,
              Key
"database_url" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= String
s
            ]

-- | Generate a 'StartupLog' from the final 'ServeOptions'.
serveOptsToLog :: (ToJSON (Logging.EngineLogType impl)) => Config.ServeOptions impl -> Server.Logging.StartupLog
serveOptsToLog :: forall impl.
ToJSON (EngineLogType impl) =>
ServeOptions impl -> StartupLog
serveOptsToLog ServeOptions impl
so =
  LogLevel -> Text -> Value -> StartupLog
Server.Logging.StartupLog LogLevel
Logging.LevelInfo Text
"server_configuration" Value
infoVal
  where
    infoVal :: Value
infoVal =
      [Pair] -> Value
J.object
        [ Key
"port" Key -> Port -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> Port
forall impl. ServeOptions impl -> Port
Config.soPort ServeOptions impl
so,
          Key
"server_host" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HostPreference -> String
forall a. Show a => a -> String
show (ServeOptions impl -> HostPreference
forall impl. ServeOptions impl -> HostPreference
Config.soHost ServeOptions impl
so),
          Key
"transaction_isolation" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TxIsolation -> String
forall a. Show a => a -> String
show (ServeOptions impl -> TxIsolation
forall impl. ServeOptions impl -> TxIsolation
Config.soTxIso ServeOptions impl
so),
          Key
"admin_secret_set" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool -> Bool
not (HashSet AdminSecretHash -> Bool
forall a. HashSet a -> Bool
HashSet.null (ServeOptions impl -> HashSet AdminSecretHash
forall impl. ServeOptions impl -> HashSet AdminSecretHash
Config.soAdminSecret ServeOptions impl
so)),
          Key
"auth_hook" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (AuthHook -> Text
Auth.ahUrl (AuthHook -> Text) -> Maybe AuthHook -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServeOptions impl -> Maybe AuthHook
forall impl. ServeOptions impl -> Maybe AuthHook
Config.soAuthHook ServeOptions impl
so),
          Key
"auth_hook_mode" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (AuthHookType -> String
forall a. Show a => a -> String
show (AuthHookType -> String)
-> (AuthHook -> AuthHookType) -> AuthHook -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthHook -> AuthHookType
Auth.ahType (AuthHook -> String) -> Maybe AuthHook -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServeOptions impl -> Maybe AuthHook
forall impl. ServeOptions impl -> Maybe AuthHook
Config.soAuthHook ServeOptions impl
so),
          Key
"jwt_secret" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (JWTConfig -> Value
forall a. ToJSON a => a -> Value
J.toJSON (JWTConfig -> Value) -> [JWTConfig] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServeOptions impl -> [JWTConfig]
forall impl. ServeOptions impl -> [JWTConfig]
Config.soJwtSecret ServeOptions impl
so),
          Key
"unauth_role" Key -> Maybe RoleName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> Maybe RoleName
forall impl. ServeOptions impl -> Maybe RoleName
Config.soUnAuthRole ServeOptions impl
so,
          Key
"cors_config" Key -> CorsConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> CorsConfig
forall impl. ServeOptions impl -> CorsConfig
Config.soCorsConfig ServeOptions impl
so,
          Key
"enable_console" Key -> ConsoleStatus -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> ConsoleStatus
forall impl. ServeOptions impl -> ConsoleStatus
Config.soConsoleStatus ServeOptions impl
so,
          Key
"console_assets_dir" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> Maybe Text
forall impl. ServeOptions impl -> Maybe Text
Config.soConsoleAssetsDir ServeOptions impl
so,
          Key
"console_sentry_dsn" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> Maybe Text
forall impl. ServeOptions impl -> Maybe Text
Config.soConsoleSentryDsn ServeOptions impl
so,
          Key
"enable_telemetry" Key -> TelemetryStatus -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> TelemetryStatus
forall impl. ServeOptions impl -> TelemetryStatus
Config.soEnableTelemetry ServeOptions impl
so,
          Key
"use_prepared_statements" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (ConnParams -> Bool
Query.cpAllowPrepare (ConnParams -> Bool)
-> (ServeOptions impl -> ConnParams) -> ServeOptions impl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServeOptions impl -> ConnParams
forall impl. ServeOptions impl -> ConnParams
Config.soConnParams) ServeOptions impl
so,
          Key
"stringify_numeric_types" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= case ServeOptions impl -> StringifyNumbers
forall impl. ServeOptions impl -> StringifyNumbers
Config.soStringifyNum ServeOptions impl
so of
            StringifyNumbers
Options.StringifyNumbers -> Bool
True
            StringifyNumbers
Options.Don'tStringifyNumbers -> Bool
False,
          Key
"v1-boolean-null-collapse" Key -> DangerouslyCollapseBooleans -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> DangerouslyCollapseBooleans
forall impl. ServeOptions impl -> DangerouslyCollapseBooleans
Config.soDangerousBooleanCollapse ServeOptions impl
so,
          Key
"enabled_apis" Key -> HashSet API -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> HashSet API
forall impl. ServeOptions impl -> HashSet API
Config.soEnabledAPIs ServeOptions impl
so,
          Key
"live_query_options" Key -> LiveQueriesOptions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> LiveQueriesOptions
forall impl. ServeOptions impl -> LiveQueriesOptions
Config.soLiveQueryOpts ServeOptions impl
so,
          Key
"enable_allowlist" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= AllowListStatus -> Bool
Config.isAllowListEnabled (ServeOptions impl -> AllowListStatus
forall impl. ServeOptions impl -> AllowListStatus
Config.soEnableAllowList ServeOptions impl
so),
          Key
"enabled_log_types" Key -> HashSet (EngineLogType impl) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> HashSet (EngineLogType impl)
forall impl. ServeOptions impl -> HashSet (EngineLogType impl)
Config.soEnabledLogTypes ServeOptions impl
so,
          Key
"log_level" Key -> LogLevel -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> LogLevel
forall impl. ServeOptions impl -> LogLevel
Config.soLogLevel ServeOptions impl
so,
          Key
"remote_schema_permissions" Key -> RemoteSchemaPermissions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> RemoteSchemaPermissions
forall impl. ServeOptions impl -> RemoteSchemaPermissions
Config.soEnableRemoteSchemaPermissions ServeOptions impl
so,
          Key
"websocket_compression_options" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CompressionOptions -> String
forall a. Show a => a -> String
show (ConnectionOptions -> CompressionOptions
WebSockets.connectionCompressionOptions (ConnectionOptions -> CompressionOptions)
-> (ServeOptions impl -> ConnectionOptions)
-> ServeOptions impl
-> CompressionOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServeOptions impl -> ConnectionOptions
forall impl. ServeOptions impl -> ConnectionOptions
Config.soConnectionOptions (ServeOptions impl -> CompressionOptions)
-> ServeOptions impl -> CompressionOptions
forall a b. (a -> b) -> a -> b
$ ServeOptions impl
so),
          Key
"websocket_keep_alive" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= KeepAliveDelay -> String
forall a. Show a => a -> String
show (ServeOptions impl -> KeepAliveDelay
forall impl. ServeOptions impl -> KeepAliveDelay
Config.soWebSocketKeepAlive ServeOptions impl
so),
          Key
"infer_function_permissions" Key -> InferFunctionPermissions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> InferFunctionPermissions
forall impl. ServeOptions impl -> InferFunctionPermissions
Config.soInferFunctionPermissions ServeOptions impl
so,
          Key
"enable_maintenance_mode" Key -> MaintenanceMode () -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> MaintenanceMode ()
forall impl. ServeOptions impl -> MaintenanceMode ()
Config.soEnableMaintenanceMode ServeOptions impl
so,
          Key
"experimental_features" Key -> HashSet ExperimentalFeature -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> HashSet ExperimentalFeature
forall impl. ServeOptions impl -> HashSet ExperimentalFeature
Config.soExperimentalFeatures ServeOptions impl
so,
          Key
"events_fetch_batch_size" Key -> Refined NonNegative Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> Refined NonNegative Int
forall impl. ServeOptions impl -> Refined NonNegative Int
Config.soEventsFetchBatchSize ServeOptions impl
so,
          Key
"graceful_shutdown_timeout" Key -> Refined NonNegative Seconds -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> Refined NonNegative Seconds
forall impl. ServeOptions impl -> Refined NonNegative Seconds
Config.soGracefulShutdownTimeout ServeOptions impl
so,
          Key
"websocket_connection_init_timeout" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= WSConnectionInitTimeout -> String
forall a. Show a => a -> String
show (ServeOptions impl -> WSConnectionInitTimeout
forall impl. ServeOptions impl -> WSConnectionInitTimeout
Config.soWebSocketConnectionInitTimeout ServeOptions impl
so),
          Key
"enable_metadata_query_logging" Key -> MetadataQueryLoggingMode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ServeOptions impl -> MetadataQueryLoggingMode
forall impl. ServeOptions impl -> MetadataQueryLoggingMode
Config.soEnableMetadataQueryLogging ServeOptions impl
so
        ]

mkGenericLog :: (ToJSON a) => Logging.LogLevel -> Text -> a -> Server.Logging.StartupLog
mkGenericLog :: forall a. ToJSON a => LogLevel -> Text -> a -> StartupLog
mkGenericLog LogLevel
logLevel Text
k a
msg =
  LogLevel -> Text -> Value -> StartupLog
Server.Logging.StartupLog LogLevel
logLevel Text
k (Value -> StartupLog) -> Value -> StartupLog
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
J.toJSON a
msg

data StartupTimeInfo = StartupTimeInfo
  { StartupTimeInfo -> Text
_stiMessage :: !Text,
    StartupTimeInfo -> Double
_stiTimeTaken :: !Double
  }

instance FromJSON StartupTimeInfo where
  parseJSON :: Value -> Parser StartupTimeInfo
parseJSON = String
-> (Object -> Parser StartupTimeInfo)
-> Value
-> Parser StartupTimeInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"StartupTimeInfo" \Object
obj -> do
    Text
_stiMessage <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"message"
    Double
_stiTimeTaken <- Object
obj Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
J..: Key
"time_taken"
    StartupTimeInfo -> Parser StartupTimeInfo
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StartupTimeInfo {Double
Text
_stiMessage :: Text
_stiTimeTaken :: Double
_stiMessage :: Text
_stiTimeTaken :: Double
..}

instance ToJSON StartupTimeInfo where
  toJSON :: StartupTimeInfo -> Value
toJSON StartupTimeInfo {Double
Text
_stiMessage :: StartupTimeInfo -> Text
_stiTimeTaken :: StartupTimeInfo -> Double
_stiMessage :: Text
_stiTimeTaken :: Double
..} =
    [Pair] -> Value
J.object [Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text
_stiMessage, Key
"time_taken" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Double
_stiTimeTaken]