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

src/library/PostgREST/MainTx.hs

@@ -43,7 +43,7 @@ import PostgREST.Plan                    (ActionPlan (..), CrudPlan (..),
                                           DbActionPlan (..), InfoPlan (..),
                                           InspectPlan (..))
 import PostgREST.Query                   (MainQuery (..))
-import PostgREST.Query.OpenApi           (TableAccess (..), TablesAccess)
+import PostgREST.Query.OpenApi           (TablesAccess, decodeTablesAccess)
 import PostgREST.SchemaCache             (SchemaCache (..))
 import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..))
 import PostgREST.SchemaCache.Routine     (Routine (..), RoutineMap)
@@ -193,18 +193,6 @@ actionResult MainQuery{mqOpenAPI=(tblsQ, funcsQ, schQ)} (MayUseDb plan@InspectPl
     decodeSchemaDesc :: HD.Result (Maybe Text)
     decodeSchemaDesc = join <$> HD.rowMaybe (nullableColumn HD.text)
 
-    decodeTablesAccess :: HD.Result TablesAccess
-    decodeTablesAccess =
-      let
-        row = (,) <$> (QualifiedIdentifier <$> column HD.text <*> column HD.text)
-                  <*> (TableAccess
-                        <$> arrayColumn HD.text
-                        <*> arrayColumn HD.text
-                        <*> arrayColumn HD.text
-                        <*> column HD.bool)
-      in
-        HM.fromList <$> HD.rowList row
-
 -- Makes sure the querystring pk matches the payload pk
 -- e.g. PUT /items?id=eq.1 { "id" : 1, .. } is accepted,
 -- PUT /items?id=eq.14 { "id" : 2, .. } is rejected.

src/library/PostgREST/Plan.hs

@@ -45,6 +45,7 @@ import PostgREST.Error                       (ApiRequestError (..), Error (..),
                                               SchemaCacheError (..))
 import PostgREST.MediaType                   (MediaType (..))
 import PostgREST.Plan.Negotiate              (negotiateContent)
+import PostgREST.Query.OpenApi               (TableAccess (..), TablesAccess)
 import PostgREST.Query.SqlFragment           (sourceCTEName)
 import PostgREST.RangeQuery                  (NonnegRange, allRange,
                                               convertToLimitZeroRange,
@@ -167,23 +168,23 @@ readPlanWarning :: ReadPlan -> Maybe (Text, Text)
 readPlanWarning ReadPlan{relName, relAlias = Just alias, relIsLegacyTargetNameMatch = True} = Just (relName, alias)
 readPlanWarning _ = Nothing
 
-actionPlan :: Action -> AppConfig -> ApiRequest -> SchemaCache -> Either Error ActionPlan
+actionPlan :: Action -> AppConfig -> ApiRequest -> TablesAccess -> SchemaCache -> Either Error ActionPlan
-actionPlan act conf apiReq sCache = case act of
+actionPlan act conf apiReq tAccess sCache = case act of
-  ActDb dbAct              -> Db <$> dbActionPlan dbAct conf apiReq sCache
+  ActDb dbAct              -> Db <$> dbActionPlan dbAct conf apiReq tAccess sCache
   ActRelationInfo ident    -> pure . NoDb $ RelInfoPlan ident
   ActRoutineInfo ident inv ->
-    let crPln = callReadPlan ident conf sCache apiReq inv in
+    let crPln = callReadPlan ident conf tAccess sCache apiReq inv in
     NoDb . RoutineInfoPlan . crProc <$> crPln
   ActSchemaInfo            -> pure $ NoDb SchemaInfoPlan
 
-dbActionPlan :: DbAction -> AppConfig -> ApiRequest -> SchemaCache -> Either Error DbActionPlan
+dbActionPlan :: DbAction -> AppConfig -> ApiRequest -> TablesAccess -> SchemaCache -> Either Error DbActionPlan
-dbActionPlan dbAct conf apiReq sCache = case dbAct of
+dbActionPlan dbAct conf apiReq tAccess sCache = case dbAct of
   ActRelationRead identifier headersOnly ->
-    toDbActPlan <$> wrappedReadPlan identifier conf sCache apiReq headersOnly
+    toDbActPlan <$> wrappedReadPlan identifier conf tAccess sCache apiReq headersOnly
   ActRelationMut identifier mut ->
-    toDbActPlan <$> mutateReadPlan mut apiReq identifier conf sCache
+    toDbActPlan <$> mutateReadPlan mut apiReq identifier conf tAccess sCache
   ActRoutine identifier invMethod ->
-    toDbActPlan <$> callReadPlan identifier conf sCache apiReq invMethod
+    toDbActPlan <$> callReadPlan identifier conf tAccess sCache apiReq invMethod
   ActSchemaRead tSchema headersOnly ->
     MayUseDb <$> inspectPlan apiReq headersOnly tSchema
   where
@@ -191,32 +192,32 @@ dbActionPlan dbAct conf apiReq sCache = case dbAct of
       MTVndPlan{} -> DbCrud True pl
       _           -> DbCrud False pl
 
-wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Bool -> Either Error CrudPlan
+wrappedReadPlan :: QualifiedIdentifier -> AppConfig -> TablesAccess -> SchemaCache -> ApiRequest -> Bool -> Either Error CrudPlan
-wrappedReadPlan  identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} headersOnly = do
+wrappedReadPlan  identifier conf tAccess sCache apiRequest@ApiRequest{iPreferences=Preferences{..},..} headersOnly = do
   qi <- findTable identifier sCache
-  rPlan <- readPlan qi conf sCache apiRequest
+  rPlan <- readPlan qi conf tAccess sCache apiRequest
   (handler, mediaType)  <- mapLeft ApiRequestErr $ negotiateContent conf apiRequest qi iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect rPlan)
   if not (null invalidPrefs) && preferHandling == Just Strict then Left $ ApiRequestErr $ InvalidPreferences invalidPrefs else Right ()
   return $ WrappedReadPlan rPlan SQL.Read handler mediaType headersOnly qi
 
-mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> SchemaCache -> Either Error CrudPlan
+mutateReadPlan :: Mutation -> ApiRequest -> QualifiedIdentifier -> AppConfig -> TablesAccess -> SchemaCache -> Either Error CrudPlan
-mutateReadPlan  mutation apiRequest@ApiRequest{iPreferences=Preferences{..},..} identifier conf sCache = do
+mutateReadPlan  mutation apiRequest@ApiRequest{iPreferences=Preferences{..},..} identifier conf tAccess sCache = do
   qi <- findTable identifier sCache
-  rPlan <- readPlan qi conf sCache apiRequest
+  rPlan <- readPlan qi conf tAccess sCache apiRequest
   mPlan <- mutatePlan mutation qi apiRequest sCache rPlan
   if not (null invalidPrefs) && preferHandling == Just Strict then Left $ ApiRequestErr $ InvalidPreferences invalidPrefs else Right ()
   (handler, mediaType)  <- mapLeft ApiRequestErr $ negotiateContent conf apiRequest qi iAcceptMediaType (dbMediaHandlers sCache) (hasDefaultSelect rPlan)
   return $ MutateReadPlan rPlan mPlan SQL.Write handler mediaType mutation qi
 
-callReadPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CrudPlan
+callReadPlan :: QualifiedIdentifier -> AppConfig -> TablesAccess -> SchemaCache -> ApiRequest -> InvokeMethod -> Either Error CrudPlan
-callReadPlan identifier conf sCache apiRequest@ApiRequest{iPreferences=Preferences{preferHandling, invalidPrefs, preferMaxAffected},..} invMethod = do
+callReadPlan identifier conf tAccess sCache apiRequest@ApiRequest{iPreferences=Preferences{preferHandling, invalidPrefs, preferMaxAffected},..} invMethod = do
   let paramKeys = case invMethod of
         InvRead _ -> S.fromList $ fst <$> qsParams'
         Inv       -> iColumns
   proc@Function{..} <- mapLeft SchemaCacheErr $
     findProc identifier paramKeys (dbRoutines sCache) iContentMediaType (invMethod == Inv)
   let relIdentifier = QualifiedIdentifier pdSchema (fromMaybe pdName $ Routine.funcTableName proc) -- done so a set returning function can embed other relations
-  rPlan <- readPlan relIdentifier conf sCache apiRequest
+  rPlan <- readPlan relIdentifier conf tAccess sCache apiRequest
   let args = case (invMethod, iContentMediaType) of
         (InvRead _, _)      -> DirectArgs $ toRpcParams proc qsParams'
         (Inv, MTUrlEncoded) -> DirectArgs $ maybe mempty (toRpcParams proc . payArray) iPayload
@@ -313,6 +314,7 @@ data ResolverContext = ResolverContext
   , representations :: RepresentationsMap
   , qi              :: QualifiedIdentifier  -- ^ The table we're currently attending; changes as we recurse into joins etc.
   , outputType      :: Text                 -- ^ The output type for the response payload; e.g. "csv", "json", "binary".
+  , tablesAccess    :: TablesAccess         -- ^ Privileges the request role has on the exposed tables.
   }
 
 resolveColumnField :: Column -> Maybe ToTsVector -> CoercibleField
@@ -376,11 +378,11 @@ resolveQueryInputField ctx field opExpr = withTextParse ctx $ resolveTypeOrUnkno
 -- | Builds the ReadPlan tree on a number of stages.
 -- | Adds filters, order, limits on its respective nodes.
 -- | Adds joins conditions obtained from resource embedding.
-readPlan :: QualifiedIdentifier -> AppConfig -> SchemaCache -> ApiRequest -> Either Error ReadPlanTree
+readPlan :: QualifiedIdentifier -> AppConfig -> TablesAccess -> SchemaCache -> ApiRequest -> Either Error ReadPlanTree
-readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows, configDbAggregates, configUrlUseLegacyTargetNames} SchemaCache{dbTables, dbRelationships, dbRepresentations} apiRequest  =
+readPlan qi@QualifiedIdentifier{..} AppConfig{configDbMaxRows, configDbAggregates, configUrlUseLegacyTargetNames} tAccess SchemaCache{dbTables, dbRelationships, dbRepresentations} apiRequest  =
   let
     -- JSON output format hardcoded for now. In the future we might want to support other output mappings such as CSV.
-    ctx = ResolverContext dbTables dbRepresentations qi "json"
+    ctx = ResolverContext dbTables dbRepresentations qi "json" tAccess
   in
     treeRestrictRange configDbMaxRows (iAction apiRequest) =<<
     addToManyOrderSelects =<<
@@ -476,7 +478,8 @@ knownColumnsInContext ResolverContext{..} =
 -- | Expand "select *" into explicit field names of the table in the following situations:
 -- * When there are data representations present.
 -- * When there is an aggregate function in a given ReadPlan or its parent.
--- * When the ReadPlan is a to-many spread relationship
+-- * When the ReadPlan is a to-many spread relationship.
+-- * When the default select(when no "select" is given) would include columns the request role cannot read.
 expandStars :: ResolverContext -> ReadPlanTree -> Either Error ReadPlanTree
 expandStars ctx rPlanTree = Right $ expandStarsForReadPlan False rPlanTree
   where
@@ -497,11 +500,13 @@ expandStars ctx rPlanTree = Right $ expandStarsForReadPlan False rPlanTree
 
 expandStarsForTable :: ResolverContext -> Bool -> ReadPlan -> ReadPlan
 expandStarsForTable ctx@ResolverContext{representations, outputType} hasAgg rp@ReadPlan{select=selectFields, relSpread=spread}
-  -- We expand if either of the below are true:
+  -- We expand the '*' select if either of the below are true:
-  -- * We have a '*' select AND there is an aggregate function in this ReadPlan's sub-tree.
+  -- * The target table has columns the request role cannot read.
-  -- * We have a '*' select AND the target table has at least one data representation.
+  -- * There is an aggregate function in this ReadPlan's sub-tree.
+  -- * The target table has at least one data representation.
   -- We ignore '*' selects that have an aggregate function attached, unless it's a `COUNT(*)` for a Spread Embed,
   -- we tag it as "full row" in that case.
+  | hasStarSelect && hasLimitedPrivileges = rp{select = concatMap (expandStarSelectField (isJust spread) accessibleColumns) selectFields}
   | hasStarSelect && (hasAgg || hasDataRepresentation) = rp{select = concatMap (expandStarSelectField (isJust spread) knownColumns) selectFields}
   | otherwise = rp
   where
@@ -510,6 +515,8 @@ expandStarsForTable ctx@ResolverContext{representations, outputType} hasAgg rp@R
     shouldExpandOrTag aggFunc = isNothing aggFunc || (isJust spread && aggFunc == Just Count)
     hasDataRepresentation = any hasOutputRep knownColumns
     knownColumns = knownColumnsInContext ctx
+    hasLimitedPrivileges = accessibleColumns /= knownColumns
+    accessibleColumns = accessibleColumnsInContext ctx
 
     hasOutputRep :: Column -> Bool
     hasOutputRep col = HM.member (colNominalType col, outputType) representations
@@ -521,6 +528,16 @@ expandStarsForTable ctx@ResolverContext{representations, outputType} hasAgg rp@R
       [sel { csField = fld { cfFullRow = True } }]
     expandStarSelectField _ _ selectField = [selectField]
 
+-- | The columns of the current table that the request role can SELECT. Falls
+-- back to all known columns when no access info is available or the role has
+-- no SELECT privilege on any column.
+accessibleColumnsInContext :: ResolverContext -> [Column]
+accessibleColumnsInContext ctx@ResolverContext{qi=tblQi, tablesAccess} =
+  case HM.lookup tblQi tablesAccess of
+    Just (TableAccess selCols _ _ _) | not (null selCols) ->
+      filter (\col -> colName col `elem` selCols) (knownColumnsInContext ctx)
+    _ -> knownColumnsInContext ctx
+
 -- | Enforces the `max-rows` config on the result
 treeRestrictRange :: Maybe Integer -> Action -> ReadPlanTree -> Either Error ReadPlanTree
 treeRestrictRange _ (ActDb (ActRelationMut _ _)) request = Right request
@@ -1059,7 +1076,7 @@ mutatePlan mutation qi ApiRequest{iPreferences=Preferences{..}, ..} SchemaCache{
           Left $ ApiRequestErr InvalidFilters
     MutationDelete -> Right $ Delete qi combinedLogic returnings
   where
-    ctx = ResolverContext dbTables dbRepresentations qi "json"
+    ctx = ResolverContext dbTables dbRepresentations qi "json" mempty
     confCols = fromMaybe pkCols qsOnConflict
     QueryParams.QueryParams{..} = iQueryParams
     returnings =

src/library/PostgREST/Query/OpenApi.hs

@@ -5,11 +5,18 @@ Description : Types for reflecting the role privileges on the OpenAPI output.
 module PostgREST.Query.OpenApi
   ( TableAccess (..)
   , TablesAccess
+  , tablesAccessStatement
+  , decodeTablesAccess
   ) where
 
 import qualified Data.HashMap.Strict             as HM
+import qualified Hasql.Decoders                  as HD
+import qualified Hasql.DynamicStatements.Statement as SQL
+import qualified Hasql.Statement                 as SQL
 
-import PostgREST.SchemaCache.Identifiers (FieldName, QualifiedIdentifier)
+import qualified PostgREST.Query.SqlFragment as SqlFragment
+
+import PostgREST.SchemaCache.Identifiers (FieldName, QualifiedIdentifier (..))
 
 import Protolude
 
@@ -27,3 +34,27 @@ data TableAccess = TableAccess
   deriving (Show, Eq)
 
 type TablesAccess = HM.HashMap QualifiedIdentifier TableAccess
+
+-- | Statement that returns the privileges the current role has on each
+-- accessible relation of the given schema.
+tablesAccessStatement :: Text -> SQL.Statement () TablesAccess
+tablesAccessStatement schema =
+  SQL.dynamicallyParameterized (SqlFragment.accessibleTables schema) decodeTablesAccess False
+
+decodeTablesAccess :: HD.Result TablesAccess
+decodeTablesAccess =
+  let
+    row = (,) <$> (QualifiedIdentifier <$> column HD.text <*> column HD.text)
+              <*> (TableAccess
+                    <$> arrayColumn HD.text
+                    <*> arrayColumn HD.text
+                    <*> arrayColumn HD.text
+                    <*> column HD.bool)
+  in
+    HM.fromList <$> HD.rowList row
+
+column :: HD.Value a -> HD.Row a
+column = HD.column . HD.nonNullable
+
+arrayColumn :: HD.Value a -> HD.Row [a]
+arrayColumn = column . HD.listArray . HD.nonNullable

test/spec/Feature/Query/DeleteSpec.hs

@@ -120,9 +120,12 @@ spec withConfig = withConfig baseCfg $
           }
 
     context "table with limited privileges" $ do
-      it "fails deleting the row when return=representation and selecting all the columns" $
+      it "succeeds deleting the row when return=representation and selecting all columns, returning only the privileged columns" $
         request methodDelete "/app_users?id=eq.1" [("Prefer", "return=representation")] mempty
-            `shouldRespondWith` 401
+            `shouldRespondWith` [json|[ { "id": 1, "email": "test@123.com" } ]|]
+            { matchStatus  = 200
+            , matchHeaders = ["Content-Range" <:> "*/*"]
+            }
 
       it "succeeds deleting the row when return=representation and selecting only the privileged columns" $
         request methodDelete "/app_users?id=eq.1&select=id,email" [("Prefer", "return=representation")]

test/spec/Feature/Query/InsertSpec.hs

@@ -720,11 +720,10 @@ spec withConfig = withConfig baseCfg $ do
         , matchHeaders = []
         }
 
-    it "fails inserting if select is not specified" $
+    it "succeeds inserting if select is not specified, returning only the accessible columns" $
       request methodPost "/limited_article_stars" [("Prefer", "return=representation")]
-        [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith`
+        [json| {"article_id": 3, "user_id": 1} |] `shouldRespondWith` [json|[{"article_id":3,"user_id":1}]|]
-      [json|{"hint":null,"details":null,"code":"42501","message":"permission denied for view limited_article_stars"}|]
+        { matchStatus  = 201
-        { matchStatus  = 401
         , matchHeaders = []
         }
 

test/spec/Feature/Query/QuerySpec.hs

@@ -36,6 +36,19 @@ spec actualPgVersion withConfig = withConfig baseCfg $ do
       , matchHeaders = ["Content-Length" <:> "120"]
       }
 
+  describe "Column-level privileges" $ do
+    it "selects only the accessible columns when no select is specified" $
+      get "/app_users?id=eq.1"
+        `shouldRespondWith`
+        [json| [{"id":1,"email":"test@123.com"}] |]
+        { matchStatus = 200 }
+
+    it "can still select the accessible columns explicitly" $
+      get "/app_users?id=eq.1&select=id,email"
+        `shouldRespondWith`
+        [json| [{"id":1,"email":"test@123.com"}] |]
+        { matchStatus = 200 }
+
   describe "Filtering response" $ do
     it "matches with equality" $
       get "/items?id=eq.5"