feat: allow logging the SQL query to stderr

- Logs the main SQL query when `log-query=main-query`. - Only logs at the current `log-level`.
2025-02-18 19:17:26 -05:00
parent 66e966d864
commit 9c880c082a
32 changed files with 267 additions and 48 deletions
@@ -17,7 +17,7 @@ module PostgREST.App


 import Control.Monad.Except     (liftEither)
-import Data.Either.Combinators  (mapLeft)
+import Data.Either.Combinators  (mapLeft, whenLeft)
 import Data.Maybe               (fromJust)
 import Data.String              (IsString (..))
 import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
@@ -43,7 +43,8 @@ import qualified PostgREST.Unix       as Unix (installSignalHandlers)
 import PostgREST.ApiRequest           (ApiRequest (..))
 import PostgREST.AppState             (AppState)
 import PostgREST.Auth.Types           (AuthResult (..))
-import PostgREST.Config               (AppConfig (..), LogLevel (..))
+import PostgREST.Config               (AppConfig (..), LogLevel (..),
+                                       LogQuery (..))
 import PostgREST.Config.PgVersion     (PgVersion (..))
 import PostgREST.Error                (Error)
 import PostgREST.Network              (resolveHost)
@@ -148,16 +149,21 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@
  (planTime, plan)                   <- withTiming $ liftEither $ Plan.actionPlan iAction conf apiReq sCache

  let query = Query.query conf authResult apiReq plan sCache pgVer
+      logSQL = lift . AppState.getObserver appState . DBQuery (Query.getSQLQuery query)

  (queryTime, queryResult) <- withTiming $ do
    case query of
      Query.NoDbQuery r -> pure r
      Query.DbQuery{..} -> do
        dbRes <- lift $ AppState.usePool appState (dqTransaction dqIsoLevel dqTxMode $ runExceptT dqDbHandler)
-        err <- liftEither . mapLeft Error.PgErr . mapLeft (Error.PgError (Just authRole /= configDbAnonRole)) $ dbRes
-        liftEither err
+        let eitherResp = mapLeft Error.PgErr . mapLeft (Error.PgError (Just authRole /= configDbAnonRole)) $ dbRes
+        when (configLogQuery /= LogQueryDisabled) $ whenLeft eitherResp $ logSQL . Error.status
+        liftEither eitherResp >>= liftEither

-  (respTime, resp) <- withTiming $ liftEither $ Response.actionResponse queryResult apiReq (T.decodeUtf8 prettyVersion, docsVersion) conf sCache iSchema iNegotiatedByProfile
+  (respTime, resp) <- withTiming $ do
+    let response = Response.actionResponse queryResult apiReq (T.decodeUtf8 prettyVersion, docsVersion) conf sCache iSchema iNegotiatedByProfile
+    when (configLogQuery /= LogQueryDisabled) $ logSQL $ either Error.status Response.pgrstStatus response
+    liftEither response

  return $ toWaiResponse (ServerTiming jwtTime parseTime planTime queryTime respTime) resp

@@ -209,6 +209,9 @@ exampleConfigFile =
      |## Logging level, the admitted values are: crit, error, warn, info and debug.
      |log-level = "error"
      |
+      |## Log the requested SQL query at the current log-level.
+      |log-query = "disabled"
+      |
      |## Determine if the OpenAPI output should follow or ignore role privileges or be disabled entirely.
      |## Admitted values: follow-privileges, ignore-privileges, disabled
      |openapi-mode = "follow-privileges"
@@ -17,6 +17,7 @@ module PostgREST.Config
  , JSPathExp(..)
  , FilterExp(..)
  , LogLevel(..)
+  , LogQuery(..)
  , OpenAPIMode(..)
  , Proxy(..)
  , toText
@@ -98,6 +99,7 @@ data AppConfig = AppConfig
  , configJwtSecretIsBase64        :: Bool
  , configJwtCacheMaxLifetime      :: Int
  , configLogLevel                 :: LogLevel
+  , configLogQuery                 :: LogQuery
  , configOpenApiMode              :: OpenAPIMode
  , configOpenApiSecurityActive    :: Bool
  , configOpenApiServerProxyUri    :: Maybe Text
@@ -126,6 +128,14 @@ dumpLogLevel = \case
  LogInfo  -> "info"
  LogDebug -> "debug"

+data LogQuery = LogQueryMain | LogQueryDisabled
+  deriving (Eq)
+
+dumpLogQuery :: LogQuery -> Text
+dumpLogQuery = \case
+  LogQueryMain     -> "main-query"
+  LogQueryDisabled -> "disabled"
+
 data OpenAPIMode = OAFollowPriv | OAIgnorePriv | OADisabled
  deriving Eq

@@ -169,6 +179,7 @@ toText conf =
      ,("jwt-secret-is-base64",          T.toLower . show . configJwtSecretIsBase64)
      ,("jwt-cache-max-lifetime",                   show . configJwtCacheMaxLifetime)
      ,("log-level",                 q . dumpLogLevel . configLogLevel)
+      ,("log-query",                 q . dumpLogQuery . configLogQuery)
      ,("openapi-mode",              q . dumpOpenApiMode . configOpenApiMode)
      ,("openapi-security-active",       T.toLower . show . configOpenApiSecurityActive)
      ,("openapi-server-proxy-uri",  q . fromMaybe mempty . configOpenApiServerProxyUri)
@@ -278,6 +289,7 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
          (optBool "secret-is-base64"))
    <*> (fromMaybe 0 <$> optInt "jwt-cache-max-lifetime")
    <*> parseLogLevel "log-level"
+    <*> parseLogQuery "log-query"
    <*> parseOpenAPIMode "openapi-mode"
    <*> (fromMaybe False <$> optBool "openapi-security-active")
    <*> parseOpenAPIServerProxyURI "openapi-server-proxy-uri"
@@ -353,6 +365,14 @@ parser optPath env dbSettings roleSettings roleIsolationLvl =
        Just "debug" -> pure LogDebug
        Just _       -> fail "Invalid logging level. Check your configuration."

+    parseLogQuery :: C.Key -> C.Parser C.Config LogQuery
+    parseLogQuery k =
+      optString k >>= \case
+        Nothing           -> pure  LogQueryDisabled
+        Just "disabled"   -> pure  LogQueryDisabled
+        Just "main-query" -> pure  LogQueryMain
+        Just _            -> fail "Invalid SQL logging value. Check your configuration."
+
    parseTxEnd :: C.Key -> ((Bool, Bool) -> Bool) -> C.Parser C.Config Bool
    parseTxEnd k f =
      optString k >>= \case
@@ -90,6 +90,10 @@ observationLogger loggerState logLevel obs = case obs of
  o@(HasqlPoolObs _) -> do
    when (logLevel >= LogDebug) $ do
      logWithZTime loggerState $ observationMessage o
+  o@(DBQuery sql status) -> do
+    -- Does not log SQL when it's empty (for OPTIONS requests or for the default OpenAPI output)
+    when (sql /= mempty && shouldLogResponse logLevel status) $ do
+      logWithZTime loggerState $ observationMessage o
  PoolRequest ->
    pure ()
  PoolRequestFullfilled ->
@@ -19,6 +19,7 @@ import qualified Data.Text.Encoding         as T
 import qualified Hasql.Connection           as SQL
 import qualified Hasql.Pool                 as SQL
 import qualified Hasql.Pool.Observation     as SQL
+import           Network.HTTP.Types.Status  (Status)
 import qualified Network.Socket             as NS
 import           Numeric                    (showFFloat)
 import           PostgREST.Config.PgVersion
@@ -46,6 +47,7 @@ data Observation
  | DBListenRetry Int
  | DBListenerGotSCacheMsg ByteString
  | DBListenerGotConfigMsg ByteString
+  | DBQuery ByteString Status
  | ConfigReadErrorObs SQL.UsageError
  | ConfigInvalidObs Text
  | ConfigSucceededObs
@@ -112,6 +114,8 @@ observationMessage = \case
    "Received a schema cache reload message on the " <> show channel <> " channel"
  DBListenerGotConfigMsg channel ->
    "Received a config reload message on the " <> show channel <> " channel"
+  DBQuery sql _ ->
+    T.decodeUtf8 sql
  ConfigReadErrorObs usageErr ->
    "Failed to query database settings for the config parameters." <> jsonMessage usageErr
  QueryRoleSettingsErrorObs usageErr ->
@@ -5,6 +5,7 @@ module PostgREST.Query
  ( Query (..)
  , QueryResult (..)
  , query
+  , getSQLQuery
  ) where

 import qualified Data.Aeson                        as JSON
@@ -69,6 +70,7 @@ data Query
    , dqTxMode      :: SQL.Mode
    , dqDbHandler   :: DbHandler QueryResult
    , dqTransaction :: SQL.IsolationLevel -> SQL.Mode -> SQL.Transaction (Either Error QueryResult) -> SQL.Session (Either Error QueryResult)
+    , dqSQL         :: ByteString
    }
  | NoDbQuery QueryResult

@@ -81,16 +83,17 @@ data QueryResult
 query :: AppConfig -> AuthResult -> ApiRequest -> ActionPlan -> SchemaCache -> PgVersion -> Query
 query _ _ _ (NoDb x) _ _ = NoDbQuery $ NoDbResult x
 query config AuthResult{..} apiReq (Db plan) sCache pgVer =
-  DbQuery isoLvl txMode dbHandler transaction
+  DbQuery isoLvl txMode dbHandler transaction mainSQLQuery
  where
    transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction
    prepared = configDbPreparedStatements config
    isoLvl = planIsoLvl config authRole plan
    txMode = planTxMode plan
+    (mainActionQuery, mainSQLQuery) = actionQuery plan config apiReq pgVer sCache
    dbHandler = do
      setPgLocals plan config authClaims authRole apiReq
      runPreReq config
-      actionQuery plan config apiReq pgVer sCache
+      mainActionQuery

 planTxMode :: DbActionPlan -> SQL.Mode
 planTxMode (DbCrud x)  = pTxMode x
@@ -104,12 +107,13 @@ planIsoLvl AppConfig{configRoleIsoLvl} role actPlan = case actPlan of
  where
    roleIsoLvl = HM.findWithDefault SQL.ReadCommitted role configRoleIsoLvl

-actionQuery :: DbActionPlan -> AppConfig -> ApiRequest -> PgVersion -> SchemaCache -> DbHandler QueryResult
+-- TODO: Generate the Hasql Statement in a diferent module after the OpenAPI functionality is removed
+actionQuery :: DbActionPlan -> AppConfig -> ApiRequest -> PgVersion -> SchemaCache -> (DbHandler QueryResult, ByteString)
 actionQuery (DbCrud plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ _ =
-  mainActionQuery
+  (mainActionQuery, mainSQLQuery)
  where
    countQuery = QueryBuilder.readPlanToCountQuery wrReadPlan
-    result = Statements.prepareRead
+    (result, mainSQLQuery) = Statements.prepareRead
      (QueryBuilder.readPlanToQuery wrReadPlan)
      (if preferCount == Just EstimatedCount then
         -- LIMIT maxRows + 1 so we can determine below that maxRows was surpassed
@@ -128,10 +132,10 @@ actionQuery (DbCrud plan@WrappedReadPlan{..}) conf@AppConfig{..} apiReq@ApiReque
      DbCrudResult plan <$> resultSetWTotal conf apiReq resultSet countQuery

 actionQuery (DbCrud plan@MutateReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} _ _ =
-  mainActionQuery
+  (mainActionQuery, mainSQLQuery)
  where
    (isPut, isInsert, pkCols) = case mrMutatePlan of {Insert{where_,insPkCols} -> ((not . null) where_, True, insPkCols); _ -> (False,False, mempty);}
-    result = Statements.prepareWrite
+    (result, mainSQLQuery) = Statements.prepareWrite
      (QueryBuilder.readPlanToQuery mrReadPlan)
      (QueryBuilder.mutatePlanToQuery mrMutatePlan)
      isInsert
@@ -160,9 +164,9 @@ actionQuery (DbCrud plan@MutateReadPlan{..}) conf@AppConfig{..} apiReq@ApiReques
      pure $ DbCrudResult plan resultSet

 actionQuery (DbCall plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{iPreferences=Preferences{..}} pgVer _ =
-  mainActionQuery
+  (mainActionQuery, mainSQLQuery)
  where
-    result = Statements.prepareCall
+    (result, mainSQLQuery) = Statements.prepareCall
      crProc
      (QueryBuilder.callPlanToQuery crCallPlan pgVer)
      (QueryBuilder.readPlanToQuery crReadPlan)
@@ -179,20 +183,23 @@ actionQuery (DbCall plan@CallReadPlan{..}) conf@AppConfig{..} apiReq@ApiRequest{
      pure $ DbCallResult plan resultSet

 actionQuery (MaybeDb plan@InspectPlan{ipSchema=tSchema}) AppConfig{..} _ _ sCache =
-  lift $ case configOpenApiMode of
-    OAFollowPriv -> do
-      tableAccess <- SQL.statement [tSchema] (SchemaCache.accessibleTables configDbPreparedStatements)
-      MaybeDbResult plan . Just <$> ((,,)
-            (HM.filterWithKey (\qi _ -> S.member qi tableAccess) $ SchemaCache.dbTables sCache)
-        <$> SQL.statement ([tSchema], configDbHoistedTxSettings) (SchemaCache.accessibleFuncs configDbPreparedStatements)
-        <*> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements))
-    OAIgnorePriv ->
-      MaybeDbResult plan . Just <$> ((,,)
-            (HM.filterWithKey (\(QualifiedIdentifier sch _) _ ->  sch == tSchema) $ SchemaCache.dbTables sCache)
-            (HM.filterWithKey (\(QualifiedIdentifier sch _) _ ->  sch == tSchema) $ SchemaCache.dbRoutines sCache)
-        <$> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements))
-    OADisabled ->
-      pure $ MaybeDbResult plan Nothing
+  (mainActionQuery, mempty)
+  where
+    mainActionQuery = lift $
+      case configOpenApiMode of
+        OAFollowPriv -> do
+          tableAccess <- SQL.statement [tSchema] (SchemaCache.accessibleTables configDbPreparedStatements)
+          MaybeDbResult plan . Just <$> ((,,)
+                (HM.filterWithKey (\qi _ -> S.member qi tableAccess) $ SchemaCache.dbTables sCache)
+            <$> SQL.statement ([tSchema], configDbHoistedTxSettings) (SchemaCache.accessibleFuncs configDbPreparedStatements)
+            <*> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements))
+        OAIgnorePriv ->
+          MaybeDbResult plan . Just <$> ((,,)
+                (HM.filterWithKey (\(QualifiedIdentifier sch _) _ ->  sch == tSchema) $ SchemaCache.dbTables sCache)
+                (HM.filterWithKey (\(QualifiedIdentifier sch _) _ ->  sch == tSchema) $ SchemaCache.dbRoutines sCache)
+            <$> SQL.statement tSchema (SchemaCache.schemaDescription configDbPreparedStatements))
+        OADisabled ->
+          pure $ MaybeDbResult plan Nothing

 -- Makes sure the querystring pk matches the payload pk
 -- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
@@ -291,3 +298,7 @@ runPreReq conf = lift $ traverse_ (SQL.statement mempty . stmt) (configDbPreRequ
      ("select " <> fromQi req <> "()")
      HD.noResult
      (configDbPreparedStatements conf)
+
+getSQLQuery :: Query -> ByteString
+getSQLQuery DbQuery{dqSQL} = dqSQL
+getSQLQuery _              = mempty
@@ -46,14 +46,14 @@ import Protolude
 readPlanToQuery :: ReadPlanTree -> SQL.Snippet
 readPlanToQuery node@(Node ReadPlan{select,from=mainQi,fromAlias,where_=logicForest,order, range_=readRange, relToParent, relJoinConds, relSelect} forest) =
  "SELECT " <>
-  intercalateSnippet ", " ((pgFmtSelectItem qi <$> (if null select && null forest then defSelect else select)) ++ joinsSelects) <> " " <>
-  fromFrag <> " " <>
-  intercalateSnippet " " joins <> " " <>
+  intercalateSnippet ", " ((pgFmtSelectItem qi <$> (if null select && null forest then defSelect else select)) ++ joinsSelects) <>
+  fromFrag <>
+  intercalateSnippet " " joins <>
  (if null logicForest && null relJoinConds
    then mempty
-    else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition relJoinConds)) <> " " <>
-  groupF qi select relSelect <> " " <>
-  orderF qi order <> " " <>
+    else " WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition relJoinConds)) <> " " <>
+  groupF qi select relSelect <>
+  orderF qi order <>
  limitOffsetF readRange
  where
    fromFrag = fromF relToParent mainQi fromAlias
@@ -94,7 +94,7 @@ getJoin :: RelSelectField -> ReadPlanTree -> SQL.Snippet
 getJoin fld node@(Node ReadPlan{relJoinType} _) =
  let
    correlatedSubquery sub al cond =
-      (if relJoinType == Just JTInner then "INNER" else "LEFT") <> " JOIN LATERAL ( " <> sub <> " ) AS " <> al <> " ON " <> cond
+      " " <> (if relJoinType == Just JTInner then "INNER" else "LEFT") <> " JOIN LATERAL ( " <> sub <> " ) AS " <> al <> " ON " <> cond
    subquery = readPlanToQuery node
    aggAlias = pgFmtIdent $ rsAggAlias fld
  in
@@ -258,7 +258,7 @@ getQualifiedIdentifier rel mainQi tblAlias = case rel of

 -- FROM clause plus implicit joins
 fromF :: Maybe Relationship -> QualifiedIdentifier -> Maybe Alias -> SQL.Snippet
-fromF rel mainQi tblAlias = "FROM " <>
+fromF rel mainQi tblAlias = " FROM " <>
  (case rel of
    -- Due to the use of CTEs on RPC, we need to cast the parameter to the table name in case of function overloading.
    -- See https://github.com/PostgREST/postgrest/issues/2963#issuecomment-1736557386
@@ -56,10 +56,11 @@ data ResultSet


 prepareWrite :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> MediaType -> MediaHandler ->
-                Maybe PreferRepresentation -> Maybe PreferResolution -> [Text] -> Bool -> SQL.Statement () ResultSet
-prepareWrite selectQuery mutateQuery isInsert isPut mt handler rep resolution pKeys =
-  SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
+                Maybe PreferRepresentation -> Maybe PreferResolution -> [Text] -> Bool -> (SQL.Statement () ResultSet, ByteString)
+prepareWrite selectQuery mutateQuery isInsert isPut mt handler rep resolution pKeys prepared =
+ (result, sql)
 where
+  result@(SQL.Statement sql _ _ _) = SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt prepared
  checkUpsert snip = if isInsert && (isPut || resolution == Just MergeDuplicates) then snip else "''"
  pgrstInsertedF = checkUpsert "nullif(current_setting('pgrst.inserted', true),'')::int"
  snippet =
@@ -93,10 +94,11 @@ prepareWrite selectQuery mutateQuery isInsert isPut mt handler rep resolution pK
    MTVndPlan{} -> planRow
    _           -> fromMaybe (RSStandard Nothing 0 mempty mempty Nothing Nothing Nothing) <$> HD.rowMaybe (standardRow False)

-prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> MediaHandler -> Bool -> SQL.Statement () ResultSet
-prepareRead selectQuery countQuery countTotal mt handler =
-  SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
+prepareRead :: SQL.Snippet -> SQL.Snippet -> Bool -> MediaType -> MediaHandler -> Bool -> (SQL.Statement () ResultSet, ByteString)
+prepareRead selectQuery countQuery countTotal mt handler prepared =
+ (result, sql)
 where
+  result@(SQL.Statement sql _ _ _) = SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt prepared
  snippet =
    "WITH " <> sourceCTE <> " AS ( " <> selectQuery <> " ) " <>
    countCTEF <> " " <>
@@ -118,10 +120,11 @@ prepareRead selectQuery countQuery countTotal mt handler =

 prepareCall :: Routine -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool ->
               MediaType -> MediaHandler -> Bool ->
-               SQL.Statement () ResultSet
-prepareCall rout callProcQuery selectQuery countQuery countTotal mt handler =
-  SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt
+               (SQL.Statement () ResultSet, ByteString)
+prepareCall rout callProcQuery selectQuery countQuery countTotal mt handler prepared =
+  (result, sql)
  where
+    result@(SQL.Statement sql _ _ _) = SQL.dynamicallyParameterized (mtSnippet mt snippet) decodeIt prepared
    snippet =
      "WITH " <> sourceCTE <> " AS (" <> callProcQuery <> ") " <>
      countCTEF <>