instead of select * inspect schema to get selectable columns

src/library/PostgREST/App.hs

@@ -31,6 +31,10 @@ import Network.Wai.Handler.Warp (defaultSettings, setBeforeMainLoop, setHost,
                                  setOnException, setPort, setServerName)
 
 import qualified Data.Text.Encoding       as T
+import qualified Hasql.Decoders                  as HD
+import qualified Hasql.DynamicStatements.Statement as SQL
+import qualified Hasql.Transaction                 as SQL
+import qualified Hasql.Transaction.Sessions        as SQL
 import qualified Network.Wai              as Wai
 import qualified Network.Wai.Handler.Warp as Warp
 import qualified Network.Wai.Header       as WaiHeader
@@ -48,6 +52,7 @@ import qualified PostgREST.Response   as Response
 import qualified PostgREST.Unix       as Unix (installSignalHandlers)
 
 import PostgREST.ApiRequest           (ApiRequest (..))
+import PostgREST.ApiRequest.Types     (Action (..), DbAction (..))
 import PostgREST.AppState             (AppState)
 import PostgREST.AppState.Reload      (runListener)
 import PostgREST.Auth.Types           (AuthResult (..))
@@ -55,6 +60,8 @@ import PostgREST.Config               (AppConfig (..))
 import PostgREST.Error                (Error)
 import PostgREST.Network              (resolveSocketToAddress)
 import PostgREST.Observation          (Observation (..))
+import PostgREST.Query.OpenApi        (TablesAccess, tablesAccessStatement)
+import PostgREST.Query.SqlFragment    (setConfigWithConstantName)
 import PostgREST.Response.Performance (ServerTiming (..), serverTimingHeader)
 import PostgREST.SchemaCache          (SchemaCache (..))
 import PostgREST.TimeIt               (timeItT)
@@ -207,7 +214,8 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jwtTime authResul
   body <- liftIO $ Wai.strictRequestBody req
 
   (parseTime, apiReq@ApiRequest{..}) <- withTiming conf $ liftEither . mapLeft Error.ApiRequestErr $ ApiRequest.userApiRequest conf prefs req body
-  (planTime, plan)                   <- withTiming conf $ liftEither $ Plan.actionPlan iAction conf apiReq sCache
+  tableAccess                        <- liftIO $ getTablesAccess appState apiReq authResult
+  (planTime, plan)                   <- withTiming conf $ liftEither $ Plan.actionPlan iAction conf apiReq tableAccess sCache
 
   let warnings = Plan.legacyWarnings plan
       legacyWarnMsg = "Embedded resource was referenced by relation name even though it has an alias. This is deprecated and will stop working in a future release."
@@ -269,6 +277,31 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jwtTime authResul
       in
       [(hWarning, "299 " <> pgrstVer <> " \"" <> encodeUtf8 warnMsg <> "\"")]
 
+-- | Fetch the privileges the request role has on the tables of the requested
+-- schema, so that the planner can restrict the default "select *" to the
+-- columns the role can actually read. Returns an empty map when the request
+-- doesn't need it or when the query fails (degrading to the previous behavior).
+getTablesAccess :: AppState -> ApiRequest -> AuthResult -> IO TablesAccess
+getTablesAccess appState ApiRequest{iAction, iSchema} AuthResult{authRole} =
+  case iAction of
+    ActDb ActRelationRead{} -> query
+    ActDb ActRelationMut{}  -> query
+    ActDb ActRoutine{}      -> query
+    _                       -> pure mempty
+  where
+    query = do
+      result <- AppState.usePool appState $
+        SQL.transactionNoRetry SQL.ReadCommitted SQL.Read $ do
+          SQL.statement mempty (roleStatement authRole)
+          SQL.statement mempty (tablesAccessStatement iSchema)
+      pure $ fromRight mempty result
+
+    roleStatement role =
+      SQL.dynamicallyParameterized
+        ("select " <> setConfigWithConstantName ("role", role))
+        HD.noResult
+        False
+
 withTiming :: (MonadError e m, MonadIO m) => AppConfig -> m a -> m (Maybe Double, a)
 withTiming AppConfig{configServerTimingEnabled} f = if configServerTimingEnabled
     then do