First attempt at deduplicating permission filters

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3362
Co-authored-by: Chris Parks <592078+cdparks@users.noreply.github.com>
GitOrigin-RevId: 802c099c26ff024e6cf594ea0317480e260486e9

CHANGELOG.md

@@ -3,6 +3,20 @@
 ## Next release
 (Add highlights/major features below)
 
+### Experimental SQL optimizations
+Row-level permissions are applied by a translation into SQL `WHERE` clauses. If
+some tables have similar row-level permission filters, then the generated SQL
+may be repetitive and not perform well, especially for GraphQL queries that make
+heavy use of relationships.
+
+This version includes an _experimental_ optimization for some SQL queries.  It
+is expressly experimental, because of the security-sensitive nature of the
+transformation that it applies. You should scrutinize the optimized SQL
+generated by this feature before using it in production.
+
+The optimization can be enabled using the `--optimize-permission-filters` flag
+or the `HASURA_GRAPHQL_OPTIMIZE_PERMISSION_FILTERS` environment variable.
+
 ### Bug fixes and improvements
 (Add entries below in the order of server, console, cli, docs, others)
 
@@ -68,7 +82,8 @@ count (
 ): Int!
 ```
   MSSQL doesn't support applying `COUNT()` on multiple columns.
-  
+
+
 ### Bug fixes and improvements
 
 - server: improved error reporting for env vars in `test_webhook_transform` metadata API endpoint

server/graphql-engine.cabal

@@ -843,6 +843,7 @@ test-suite graphql-engine-tests
   hs-source-dirs: src-test
   main-is: Main.hs
   other-modules:
+    Data.HashMap.Strict.ExtendedSpec
     Data.NonNegativeIntSpec
     Data.Parser.CacheControlSpec
     Data.Parser.JSONPathSpec

server/src-lib/Data/HashMap/Strict/Extended.hs

@@ -9,6 +9,7 @@ module Data.HashMap.Strict.Extended
     lpadZip,
     mapKeys,
     unionsWith,
+    isInverseOf,
   )
 where
 
@@ -28,7 +29,8 @@ fromListOn :: (Eq k, Hashable k) => (v -> k) -> [v] -> HashMap k v
 fromListOn f = fromList . Prelude.map (\v -> (f v, v))
 
 -- | Like 'M.unions', but keeping all elements in the result.
-unionsAll :: (Eq k, Hashable k, Foldable t) => t (HashMap k v) -> HashMap k (NonEmpty v)
+unionsAll ::
+  (Eq k, Hashable k, Foldable t) => t (HashMap k v) -> HashMap k (NonEmpty v)
 unionsAll = F.foldl' (\a b -> unionWith (<>) a (fmap (:| []) b)) M.empty
 
 -- | Given a 'Foldable' sequence of values and a function that extracts a key from each value,
@@ -40,19 +42,28 @@ unionsAll = F.foldl' (\a b -> unionWith (<>) a (fmap (:| []) b)) M.empty
 groupOn :: (Eq k, Hashable k, Foldable t) => (v -> k) -> t v -> HashMap k [v]
 groupOn f = fmap F.toList . groupOnNE f
 
-groupOnNE :: (Eq k, Hashable k, Foldable t) => (v -> k) -> t v -> HashMap k (NonEmpty v)
-groupOnNE f = Prelude.foldr (\v -> M.alter (Just . (v :|) . maybe [] F.toList) (f v)) M.empty
+groupOnNE ::
+  (Eq k, Hashable k, Foldable t) => (v -> k) -> t v -> HashMap k (NonEmpty v)
+groupOnNE f =
+  Prelude.foldr
+    (\v -> M.alter (Just . (v :|) . maybe [] F.toList) (f v))
+    M.empty
 
-differenceOn :: (Eq k, Hashable k, Foldable t) => (v -> k) -> t v -> t v -> HashMap k v
+differenceOn ::
+  (Eq k, Hashable k, Foldable t) => (v -> k) -> t v -> t v -> HashMap k v
 differenceOn f = M.difference `on` (fromListOn f . F.toList)
 
 -- | Analogous to 'A.lpadZip', but on 'HashMap's instead of lists.
-lpadZip :: (Eq k, Hashable k) => HashMap k a -> HashMap k b -> HashMap k (Maybe a, b)
+lpadZip ::
+  (Eq k, Hashable k) => HashMap k a -> HashMap k b -> HashMap k (Maybe a, b)
 lpadZip left =
-  catMaybes . flip A.alignWith left \case
-    This _ -> Nothing
-    That b -> Just (Nothing, b)
-    These a b -> Just (Just a, b)
+  catMaybes . flip
+    A.alignWith
+    left
+    \case
+      This _ -> Nothing
+      That b -> Just (Nothing, b)
+      These a b -> Just (Just a, b)
 
 -- | @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
 --
@@ -75,6 +86,29 @@ mapKeys f = fromList . foldrWithKey (\k x xs -> (f k, x) : xs) []
 -- >     == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")]
 --
 -- copied from https://hackage.haskell.org/package/containers-0.6.4.1/docs/src/Data.Map.Internal.html#unionsWith
-unionsWith :: (Foldable f, Hashable k, Ord k) => (a -> a -> a) -> f (HashMap k a) -> HashMap k a
-unionsWith f ts =
-  F.foldl' (unionWith f) empty ts
+unionsWith ::
+  (Foldable f, Hashable k, Ord k) =>
+  (a -> a -> a) ->
+  f (HashMap k a) ->
+  HashMap k a
+unionsWith f ts = F.foldl' (unionWith f) empty ts
+
+-- | Determines whether the left-hand-side and the right-hand-side are inverses of each other.
+--
+-- More specifically, for two maps @A@ and @B@, 'isInverseOf' is satisfied when both of the
+-- following are true:
+-- 1. @∀ key ∈ A. A[key] ∈  B ∧ B[A[key]] == key@
+-- 2. @∀ key ∈ B. B[key] ∈  A ∧ A[B[key]] == key@
+isInverseOf ::
+  (Eq k, Hashable k, Eq v, Hashable v) => HashMap k v -> HashMap v k -> Bool
+lhs `isInverseOf` rhs = lhs `invertedBy` rhs && rhs `invertedBy` lhs
+  where
+    invertedBy ::
+      forall s t.
+      (Eq s, Eq t, Hashable t) =>
+      HashMap s t ->
+      HashMap t s ->
+      Bool
+    a `invertedBy` b = and $ do
+      (k, v) <- M.toList a
+      pure $ M.lookup v b == Just k

server/src-lib/Hasura/App.hs

@@ -369,7 +369,7 @@ initialiseServeCtx env GlobalCtx {..} so@ServeOptions {..} = do
                   }
               sourceConnInfo = PostgresSourceConnInfo dbUrlConf (Just connSettings) (Q.cpAllowPrepare soConnParams) soTxIso Nothing
            in PostgresConnConfiguration sourceConnInfo Nothing
-      sqlGenCtx = SQLGenCtx soStringifyNum soDangerousBooleanCollapse
+      sqlGenCtx = SQLGenCtx soStringifyNum soDangerousBooleanCollapse soOptimizePermissionFilters
 
   let serverConfigCtx =
         ServerConfigCtx
@@ -657,7 +657,7 @@ mkHGEServer setupHook env ServeOptions {..} ServeCtx {..} initTime postPollHook
   -- NOTE: be sure to compile WITHOUT code coverage, for this to work properly.
   liftIO disableAssertNF
 
-  let sqlGenCtx = SQLGenCtx soStringifyNum soDangerousBooleanCollapse
+  let sqlGenCtx = SQLGenCtx soStringifyNum soDangerousBooleanCollapse soOptimizePermissionFilters
       Loggers loggerCtx logger _ = _scLoggers
   --SchemaSyncCtx{..} = _scSchemaSyncCtx
 

server/src-lib/Hasura/GraphQL/Schema.hs

@@ -90,6 +90,7 @@ buildGQLContext queryType sources allRemoteSchemas allActions customTypes = do
           queryType
           adminRemoteRelationshipQueryCtx
           FunctionPermissionsInferred
+          optimizePermissionFilters
 
   -- build the admin DB-only context so that we can check against name clashes with remotes
   -- TODO: Is there a better way to check for conflicts without actually building the admin schema?
@@ -167,7 +168,7 @@ buildRoleContext ::
   RemoteSchemaPermsCtx ->
   m (RoleContext GQLContext)
 buildRoleContext
-  (SQLGenCtx stringifyNum boolCollapse, queryType, functionPermsCtx)
+  (SQLGenCtx stringifyNum dangerousBooleanCollapse optimizePermissionFilters, queryType, functionPermsCtx)
   sources
   allRemoteSchemas
   allActionInfos
@@ -190,10 +191,11 @@ buildRoleContext
           roleQueryContext =
             QueryContext
               stringifyNum
-              boolCollapse
+              dangerousBooleanCollapse
               queryType
               remoteRelationshipQueryContext
               functionPermsCtx
+              optimizePermissionFilters
       runMonadSchema role roleQueryContext sources $ do
         fieldsList <- traverse (buildBackendSource buildSource) $ toList sources
         let (queryFields, mutationFrontendFields, mutationBackendFields) = mconcat fieldsList
@@ -265,7 +267,7 @@ buildRelayRoleContext ::
   RoleName ->
   m (RoleContext GQLContext)
 buildRelayRoleContext
-  (SQLGenCtx stringifyNum boolCollapse, queryType, functionPermsCtx)
+  (SQLGenCtx stringifyNum dangerousBooleanCollapse optimizePermissionFilters, queryType, functionPermsCtx)
   sources
   allActionInfos
   customTypes
@@ -276,10 +278,11 @@ buildRelayRoleContext
     let roleQueryContext =
           QueryContext
             stringifyNum
-            boolCollapse
+            dangerousBooleanCollapse
             queryType
             mempty
             functionPermsCtx
+            optimizePermissionFilters
     runMonadSchema role roleQueryContext sources do
       fieldsList <- traverse (buildBackendSource buildSource) $ toList sources
 

server/src-lib/Hasura/GraphQL/Schema/Backend.hs

@@ -78,7 +78,12 @@ type MonadBuildSchema b r m n =
 -- tandem.
 --
 -- See <#modelling Note BackendSchema modelling principles>.
-class Backend b => BackendSchema (b :: BackendType) where
+class
+  ( Backend b,
+    Eq (BooleanOperators b (UnpreparedValue b))
+  ) =>
+  BackendSchema (b :: BackendType)
+  where
   -- top level parsers
   buildTableQueryFields ::
     MonadBuildSchema b r m n =>

server/src-lib/Hasura/GraphQL/Schema/Common.hs

@@ -8,7 +8,7 @@ module Hasura.GraphQL.Schema.Common
     AnnotatedActionField,
     AnnotatedActionFields,
     EdgeFields,
-    QueryContext (QueryContext, qcDangerousBooleanCollapse, qcFunctionPermsContext, qcQueryType, qcRemoteRelationshipContext, qcStringifyNum),
+    QueryContext (QueryContext, qcDangerousBooleanCollapse, qcFunctionPermsContext, qcQueryType, qcRemoteRelationshipContext, qcStringifyNum, qcOptimizePermissionFilters),
     RemoteRelationshipQueryContext (RemoteRelationshipQueryContext, _rrscParsedIntrospection),
     SelectArgs,
     SelectExp,
@@ -87,12 +87,14 @@ data RemoteRelationshipQueryContext = RemoteRelationshipQueryContext
   }
 
 data QueryContext = QueryContext
-  { qcStringifyNum :: !Bool,
+  { qcStringifyNum :: Bool,
     -- | should boolean fields be collapsed to True when null is given?
-    qcDangerousBooleanCollapse :: !Bool,
-    qcQueryType :: !ET.GraphQLQueryType,
-    qcRemoteRelationshipContext :: !(HashMap RemoteSchemaName RemoteRelationshipQueryContext),
-    qcFunctionPermsContext :: !FunctionPermissionsCtx
+    qcDangerousBooleanCollapse :: Bool,
+    qcQueryType :: ET.GraphQLQueryType,
+    qcRemoteRelationshipContext :: HashMap RemoteSchemaName RemoteRelationshipQueryContext,
+    qcFunctionPermsContext :: FunctionPermissionsCtx,
+    -- | 'True' when we should attempt to use experimental SQL optimization passes
+    qcOptimizePermissionFilters :: Bool
   }
 
 textToName :: MonadError QErr m => Text -> m G.Name

server/src-lib/Hasura/GraphQL/Schema/Select.hs

@@ -1110,6 +1110,86 @@ fieldSelection sourceName table maybePkeyColumns fieldInfo selectPermissions = d
       let lhsFields = _rfiLHS remoteFieldInfo
       pure $ map (fmap (IR.AFRemote . IR.RemoteRelationshipSelect lhsFields)) relationshipFields
 
+{- Note [Permission filter deduplication]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+1. `T` and `U` are tables.
+
+1. `r` is a relationship on `T` to table `U` with the join condition, `T.c =
+   U.d` where `c` and `d` are columns on tables `T` and `U` respectively.
+
+1. `s` is a relationship on `U` to table `T` with the join condition, `U.d =
+   T.c`.
+
+1. `p(T)` and `p(U)` denote the permission filters on table `T` and `U`
+   respectively for some role `R`.
+
+Consider the SQL that we generate for this query:
+
+```
+query {
+  T {
+    c
+    r {
+      d
+    }
+  }
+}
+```
+
+It would be along these lines:
+
+```sql
+SELECT
+  *
+FROM
+  (
+    SELECT * FROM T WHERE p(T)
+  ) AS T
+  LEFT OUTER JOIN LATERAL
+  (
+    SELECT * FROM U WHERE T.c = U.d AND p(U)
+  ) AS U
+  ON TRUE
+```
+
+The expression `T.c = U.d` is the join condition for relationship `r`. Note
+that we use lateral joins, so the join condition is not expressed using `ON`
+but on the where clause of `U`.
+
+Now, let's say `p(U)` is of the form `{ s : p(T) }`.
+
+```sql
+SELECT
+  *
+FROM
+  (
+    SELECT * FROM T WHERE p(T)
+  ) AS T
+  LEFT OUTER JOIN LATERAL
+  (
+    SELECT * FROM U WHERE T.c = U.d
+    AND EXISTS (
+      SELECT 1 FROM T WHERE U.d = T.c AND p(T)
+    )
+  ) AS U
+  ON TRUE
+```
+
+`p(U)`, i.e, `{ s : p(T) }` got expanded to
+
+```sql
+EXISTS (
+  SELECT 1 FROM T WHERE U.d = T.c AND p(T)
+)
+```
+
+Now, assuming, in the `WHERE` clause for `U`, that `T.c = U.d` holds, then the
+`EXISTS` clause must evaluate to true. The `EXISTS` clause must evaluate to true
+because the row from `T` we are joining against is exactly such a row satisfying
+`p(T)`. In other words, the row obtained from `T` (as the left-hand side of the
+join) satisfies `p(T)`.
+-}
+
 -- | Field parsers for a table relationship
 relationshipField ::
   forall b r m n.
@@ -1118,11 +1198,37 @@ relationshipField ::
   TableName b ->
   RelInfo b ->
   m (Maybe [FieldParser n (AnnotatedField b)])
-relationshipField sourceName table RelInfo {..} = runMaybeT do
-  otherTableInfo <- lift $ askTableInfo sourceName riRTable
+relationshipField sourceName table ri = runMaybeT do
+  optimizePermissionFilters <- asks $ qcOptimizePermissionFilters . getter
+  otherTableInfo <- lift $ askTableInfo sourceName $ riRTable ri
   remotePerms <- MaybeT $ tableSelectPermissions otherTableInfo
-  relFieldName <- lift $ textToName $ relNameToTxt riName
-  case riType of
+  relFieldName <- lift $ textToName $ relNameToTxt $ riName ri
+  -- START black magic to deduplicate permission checks
+  thisTablePerm <-
+    IR._tpFilter . tablePermissionsInfo
+      <$> MaybeT (tableSelectPermissions =<< askTableInfo @b sourceName table)
+  let deduplicatePermissions :: AnnBoolExp b (UnpreparedValue b) -> AnnBoolExp b (UnpreparedValue b)
+      deduplicatePermissions x =
+        case (optimizePermissionFilters, x) of
+          (True, BoolAnd [BoolFld (AVRelationship remoteRI remoteTablePerm)]) ->
+            -- Here we try to figure out if the "forwards" joining condition
+            -- from `table` to the related table `riRTable ri` is equal to the
+            -- "backwards" joining condition from the related table back to
+            -- `table`.  If it is, then we can optimize the row-level permission
+            -- filters by dropping them here.
+            if riRTable remoteRI == table
+              && riMapping remoteRI `Map.isInverseOf` riMapping ri
+              && thisTablePerm == remoteTablePerm
+              then BoolAnd []
+              else x
+          _ -> x
+      deduplicatePermissions' :: SelectExp b -> SelectExp b
+      deduplicatePermissions' expr =
+        let newFilter = deduplicatePermissions (IR._tpFilter (IR._asnPerm expr))
+         in expr {IR._asnPerm = (IR._asnPerm expr) {IR._tpFilter = newFilter}}
+  -- END black magic to deduplicate permission checks
+
+  case riType ri of
     ObjRel -> do
       let desc = Just $ G.Description "An object relationship"
       selectionSetParser <- lift $ tableSelectionSet sourceName otherTableInfo remotePerms
@@ -1158,11 +1264,11 @@ relationshipField sourceName table RelInfo {..} = runMaybeT do
       -- probably not a very widely used mode of use.  The impact of this
       -- suboptimality is merely that in introspection some fields might get
       -- marked nullable which are in fact known to always be non-null.
-      nullable <- case (riIsManual, riInsertOrder) of
+      nullable <- case (riIsManual ri, riInsertOrder ri) of
         -- Automatically generated forward relationship
         (False, BeforeParent) -> do
           tableInfo <- askTableInfo @b sourceName table
-          let columns = Map.keys riMapping
+          let columns = Map.keys $ riMapping ri
               fieldInfoMap = _tciFieldInfoMap $ _tiCoreInfo tableInfo
               findColumn col = Map.lookup (fromCol @b col) fieldInfoMap ^? _Just . _FIColumn
           -- Fetch information about the referencing columns of the foreign key
@@ -1179,16 +1285,19 @@ relationshipField sourceName table RelInfo {..} = runMaybeT do
             P.subselection_ relFieldName desc selectionSetParser
               <&> \fields ->
                 IR.AFObjectRelation $
-                  IR.AnnRelationSelectG riName riMapping $
-                    IR.AnnObjectSelectG fields riRTable $
-                      IR._tpFilter $ tablePermissionsInfo remotePerms
+                  IR.AnnRelationSelectG (riName ri) (riMapping ri) $
+                    IR.AnnObjectSelectG fields (riRTable ri) $
+                      deduplicatePermissions $
+                        IR._tpFilter $ tablePermissionsInfo remotePerms
     ArrRel -> do
       let arrayRelDesc = Just $ G.Description "An array relationship"
       otherTableParser <- lift $ selectTable sourceName otherTableInfo relFieldName arrayRelDesc remotePerms
       let arrayRelField =
             otherTableParser <&> \selectExp ->
               IR.AFArrayRelation $
-                IR.ASSimple $ IR.AnnRelationSelectG riName riMapping selectExp
+                IR.ASSimple $
+                  IR.AnnRelationSelectG (riName ri) (riMapping ri) $
+                    deduplicatePermissions' selectExp
           relAggFieldName = relFieldName <> $$(G.litName "_aggregate")
           relAggDesc = Just $ G.Description "An aggregate relationship"
       remoteAggField <- lift $ selectTableAggregate sourceName otherTableInfo relAggFieldName relAggDesc remotePerms
@@ -1207,8 +1316,8 @@ relationshipField sourceName table RelInfo {..} = runMaybeT do
       pure $
         catMaybes
           [ Just arrayRelField,
-            fmap (IR.AFArrayRelation . IR.ASAggregate . IR.AnnRelationSelectG riName riMapping) <$> remoteAggField,
-            fmap (IR.AFArrayRelation . IR.ASConnection . IR.AnnRelationSelectG riName riMapping) <$> remoteConnectionField
+            fmap (IR.AFArrayRelation . IR.ASAggregate . IR.AnnRelationSelectG (riName ri) (riMapping ri)) <$> remoteAggField,
+            fmap (IR.AFArrayRelation . IR.ASConnection . IR.AnnRelationSelectG (riName ri) (riMapping ri)) <$> remoteConnectionField
           ]
 
 -- | Computed field parser

server/src-lib/Hasura/RQL/Types/Backend.hs

@@ -99,6 +99,8 @@ class
     -- Type constraints.
     Eq (CountType b),
     Show (CountType b),
+    Eq (ScalarValue b),
+    Show (ScalarValue b),
     -- Extension constraints.
     Eq (XNodesAgg b),
     Show (XNodesAgg b),

server/src-lib/Hasura/RQL/Types/Common.hs

@@ -235,7 +235,8 @@ isSystemDefined = unSystemDefined
 
 data SQLGenCtx = SQLGenCtx
   { stringifyNum :: Bool,
-    dangerousBooleanCollapse :: Bool
+    dangerousBooleanCollapse :: Bool,
+    optimizePermissionFilters :: Bool
   }
   deriving (Show, Eq)
 

server/src-lib/Hasura/Server/Init.hs

@@ -266,6 +266,9 @@ mkServeOptions rso = do
     WSConnectionInitTimeout . fromIntegral . fromMaybe 3
       <$> withEnv (rsoWebSocketConnectionInitTimeout rso) (fst webSocketConnectionInitTimeoutEnv)
 
+  optimizePermissionFilters <-
+    fromMaybe False <$> withEnv (rsoOptimizePermissionFilters rso) (fst optimizePermissionFiltersEnv)
+
   pure $
     ServeOptions
       port
@@ -305,6 +308,7 @@ mkServeOptions rso = do
       webSocketConnectionInitTimeout
       EventingEnabled
       ReadOnlyModeDisabled
+      optimizePermissionFilters
   where
     defaultAsyncActionsFetchInterval = Interval 1000 -- 1000 Milliseconds or 1 Second
     defaultSchemaPollInterval = Interval 1000 -- 1000 Milliseconds or 1 Second
@@ -1343,7 +1347,7 @@ serveOptsToLog so =
         [ "port" J..= soPort so,
           "server_host" J..= show (soHost so),
           "transaction_isolation" J..= show (soTxIso so),
-          "admin_secret_set" J..= (not $ Set.null (soAdminSecret so)),
+          "admin_secret_set" J..= not (Set.null (soAdminSecret so)),
           "auth_hook" J..= (ahUrl <$> soAuthHook so),
           "auth_hook_mode" J..= (show . ahType <$> soAuthHook so),
           "jwt_secret" J..= (J.toJSON <$> soJwtSecret so),
@@ -1426,6 +1430,7 @@ serveOptionsParser =
     <*> parseEventsFetchBatchSize
     <*> parseGracefulShutdownTimeout
     <*> parseWebSocketConnectionInitTimeout
+    <*> parseOptimizePermissionFilters
 
 -- | This implements the mapping between application versions
 -- and catalog schema versions.
@@ -1508,3 +1513,18 @@ parseWebSocketConnectionInitTimeout =
       ( long "websocket-connection-init-timeout"
           <> help (snd webSocketConnectionInitTimeoutEnv)
       )
+
+optimizePermissionFiltersEnv :: (String, String)
+optimizePermissionFiltersEnv =
+  ( "HASURA_GRAPHQL_OPTIMIZE_PERMISSION_FILTERS",
+    "Use experimental SQL optimization transformations for permission filters"
+  )
+
+parseOptimizePermissionFilters :: Parser (Maybe Bool)
+parseOptimizePermissionFilters =
+  optional $
+    option
+      (eitherReader parseStrAsBool)
+      ( long "optimize-permission-filters"
+          <> help (snd optimizePermissionFiltersEnv)
+      )

server/src-lib/Hasura/Server/Init/Config.hs

@@ -115,43 +115,44 @@ $( J.deriveJSON
 instance Hashable API
 
 data RawServeOptions impl = RawServeOptions
-  { rsoPort :: !(Maybe Int),
-    rsoHost :: !(Maybe HostPreference),
-    rsoConnParams :: !RawConnParams,
-    rsoTxIso :: !(Maybe Q.TxIsolation),
-    rsoAdminSecret :: !(Maybe AdminSecretHash),
-    rsoAuthHook :: !RawAuthHook,
-    rsoJwtSecret :: !(Maybe JWTConfig),
-    rsoUnAuthRole :: !(Maybe RoleName),
-    rsoCorsConfig :: !(Maybe CorsConfig),
-    rsoEnableConsole :: !Bool,
-    rsoConsoleAssetsDir :: !(Maybe Text),
-    rsoEnableTelemetry :: !(Maybe Bool),
-    rsoWsReadCookie :: !Bool,
-    rsoStringifyNum :: !Bool,
-    rsoDangerousBooleanCollapse :: !(Maybe Bool),
-    rsoEnabledAPIs :: !(Maybe [API]),
-    rsoMxRefetchInt :: !(Maybe LQ.RefetchInterval),
-    rsoMxBatchSize :: !(Maybe LQ.BatchSize),
-    rsoEnableAllowlist :: !Bool,
-    rsoEnabledLogTypes :: !(Maybe [L.EngineLogType impl]),
-    rsoLogLevel :: !(Maybe L.LogLevel),
-    rsoDevMode :: !Bool,
-    rsoAdminInternalErrors :: !(Maybe Bool),
-    rsoEventsHttpPoolSize :: !(Maybe Int),
-    rsoEventsFetchInterval :: !(Maybe Milliseconds),
-    rsoAsyncActionsFetchInterval :: !(Maybe Milliseconds),
-    rsoLogHeadersFromEnv :: !Bool,
-    rsoEnableRemoteSchemaPermissions :: !Bool,
-    rsoWebSocketCompression :: !Bool,
-    rsoWebSocketKeepAlive :: !(Maybe Int),
-    rsoInferFunctionPermissions :: !(Maybe Bool),
-    rsoEnableMaintenanceMode :: !Bool,
-    rsoSchemaPollInterval :: !(Maybe Milliseconds),
-    rsoExperimentalFeatures :: !(Maybe [ExperimentalFeature]),
-    rsoEventsFetchBatchSize :: !(Maybe NonNegativeInt),
-    rsoGracefulShutdownTimeout :: !(Maybe Seconds),
-    rsoWebSocketConnectionInitTimeout :: !(Maybe Int)
+  { rsoPort :: Maybe Int,
+    rsoHost :: Maybe HostPreference,
+    rsoConnParams :: RawConnParams,
+    rsoTxIso :: Maybe Q.TxIsolation,
+    rsoAdminSecret :: Maybe AdminSecretHash,
+    rsoAuthHook :: RawAuthHook,
+    rsoJwtSecret :: Maybe JWTConfig,
+    rsoUnAuthRole :: Maybe RoleName,
+    rsoCorsConfig :: Maybe CorsConfig,
+    rsoEnableConsole :: Bool,
+    rsoConsoleAssetsDir :: Maybe Text,
+    rsoEnableTelemetry :: Maybe Bool,
+    rsoWsReadCookie :: Bool,
+    rsoStringifyNum :: Bool,
+    rsoDangerousBooleanCollapse :: Maybe Bool,
+    rsoEnabledAPIs :: Maybe [API],
+    rsoMxRefetchInt :: Maybe LQ.RefetchInterval,
+    rsoMxBatchSize :: Maybe LQ.BatchSize,
+    rsoEnableAllowlist :: Bool,
+    rsoEnabledLogTypes :: Maybe [L.EngineLogType impl],
+    rsoLogLevel :: Maybe L.LogLevel,
+    rsoDevMode :: Bool,
+    rsoAdminInternalErrors :: Maybe Bool,
+    rsoEventsHttpPoolSize :: Maybe Int,
+    rsoEventsFetchInterval :: Maybe Milliseconds,
+    rsoAsyncActionsFetchInterval :: Maybe Milliseconds,
+    rsoLogHeadersFromEnv :: Bool,
+    rsoEnableRemoteSchemaPermissions :: Bool,
+    rsoWebSocketCompression :: Bool,
+    rsoWebSocketKeepAlive :: Maybe Int,
+    rsoInferFunctionPermissions :: Maybe Bool,
+    rsoEnableMaintenanceMode :: Bool,
+    rsoSchemaPollInterval :: Maybe Milliseconds,
+    rsoExperimentalFeatures :: Maybe [ExperimentalFeature],
+    rsoEventsFetchBatchSize :: Maybe NonNegativeInt,
+    rsoGracefulShutdownTimeout :: Maybe Seconds,
+    rsoWebSocketConnectionInitTimeout :: Maybe Int,
+    rsoOptimizePermissionFilters :: Maybe Bool
   }
 
 -- | @'ResponseInternalErrorsConfig' represents the encoding of the internal
@@ -186,43 +187,44 @@ defaultWSConnectionInitTimeout :: WSConnectionInitTimeout
 defaultWSConnectionInitTimeout = WSConnectionInitTimeout $ fromIntegral (3 :: Int)
 
 data ServeOptions impl = ServeOptions
-  { soPort :: !Int,
-    soHost :: !HostPreference,
-    soConnParams :: !Q.ConnParams,
-    soTxIso :: !Q.TxIsolation,
-    soAdminSecret :: !(Set.HashSet AdminSecretHash),
-    soAuthHook :: !(Maybe AuthHook),
-    soJwtSecret :: !(Maybe JWTConfig),
-    soUnAuthRole :: !(Maybe RoleName),
-    soCorsConfig :: !CorsConfig,
-    soEnableConsole :: !Bool,
-    soConsoleAssetsDir :: !(Maybe Text),
-    soEnableTelemetry :: !Bool,
-    soStringifyNum :: !Bool,
-    soDangerousBooleanCollapse :: !Bool,
-    soEnabledAPIs :: !(Set.HashSet API),
-    soLiveQueryOpts :: !LQ.LiveQueriesOptions,
-    soEnableAllowlist :: !Bool,
-    soEnabledLogTypes :: !(Set.HashSet (L.EngineLogType impl)),
-    soLogLevel :: !L.LogLevel,
-    soResponseInternalErrorsConfig :: !ResponseInternalErrorsConfig,
-    soEventsHttpPoolSize :: !(Maybe Int),
-    soEventsFetchInterval :: !(Maybe Milliseconds),
-    soAsyncActionsFetchInterval :: !OptionalInterval,
-    soLogHeadersFromEnv :: !Bool,
-    soEnableRemoteSchemaPermissions :: !RemoteSchemaPermsCtx,
-    soConnectionOptions :: !WS.ConnectionOptions,
-    soWebsocketKeepAlive :: !KeepAliveDelay,
-    soInferFunctionPermissions :: !FunctionPermissionsCtx,
-    soEnableMaintenanceMode :: !MaintenanceMode,
-    soSchemaPollInterval :: !OptionalInterval,
-    soExperimentalFeatures :: !(Set.HashSet ExperimentalFeature),
-    soEventsFetchBatchSize :: !NonNegativeInt,
-    soDevMode :: !Bool,
-    soGracefulShutdownTimeout :: !Seconds,
-    soWebsocketConnectionInitTimeout :: !WSConnectionInitTimeout,
-    soEventingMode :: !EventingMode,
-    soReadOnlyMode :: !ReadOnlyMode
+  { soPort :: Int,
+    soHost :: HostPreference,
+    soConnParams :: Q.ConnParams,
+    soTxIso :: Q.TxIsolation,
+    soAdminSecret :: Set.HashSet AdminSecretHash,
+    soAuthHook :: Maybe AuthHook,
+    soJwtSecret :: Maybe JWTConfig,
+    soUnAuthRole :: Maybe RoleName,
+    soCorsConfig :: CorsConfig,
+    soEnableConsole :: Bool,
+    soConsoleAssetsDir :: Maybe Text,
+    soEnableTelemetry :: Bool,
+    soStringifyNum :: Bool,
+    soDangerousBooleanCollapse :: Bool,
+    soEnabledAPIs :: Set.HashSet API,
+    soLiveQueryOpts :: LQ.LiveQueriesOptions,
+    soEnableAllowlist :: Bool,
+    soEnabledLogTypes :: Set.HashSet (L.EngineLogType impl),
+    soLogLevel :: L.LogLevel,
+    soResponseInternalErrorsConfig :: ResponseInternalErrorsConfig,
+    soEventsHttpPoolSize :: Maybe Int,
+    soEventsFetchInterval :: Maybe Milliseconds,
+    soAsyncActionsFetchInterval :: OptionalInterval,
+    soLogHeadersFromEnv :: Bool,
+    soEnableRemoteSchemaPermissions :: RemoteSchemaPermsCtx,
+    soConnectionOptions :: WS.ConnectionOptions,
+    soWebsocketKeepAlive :: KeepAliveDelay,
+    soInferFunctionPermissions :: FunctionPermissionsCtx,
+    soEnableMaintenanceMode :: MaintenanceMode,
+    soSchemaPollInterval :: OptionalInterval,
+    soExperimentalFeatures :: Set.HashSet ExperimentalFeature,
+    soEventsFetchBatchSize :: NonNegativeInt,
+    soDevMode :: Bool,
+    soGracefulShutdownTimeout :: Seconds,
+    soWebsocketConnectionInitTimeout :: WSConnectionInitTimeout,
+    soEventingMode :: EventingMode,
+    soReadOnlyMode :: ReadOnlyMode,
+    soOptimizePermissionFilters :: Bool
   }
 
 data DowngradeOptions = DowngradeOptions

server/src-test/Data/HashMap/Strict/ExtendedSpec.hs

@@ -0,0 +1,45 @@
+module Data.HashMap.Strict.ExtendedSpec
+  ( spec,
+  )
+where
+
+import Data.HashMap.Strict.Extended qualified as Map
+import Hasura.Prelude
+import Test.Hspec
+import Test.QuickCheck
+
+spec :: Spec
+spec = describe "isInverseOf" $ do
+  it "is satisfied by maps with the same unique keys as values" $
+    property $
+      \(xs :: [Int]) -> do
+        let m = Map.fromList $ zip xs xs
+        m `Map.isInverseOf` m
+
+  it "is satisfied by maps with swapped unique keys and values" $
+    property $
+      \(vals :: [Int]) -> do
+        let keys = show <$> vals
+        let forward = Map.fromList $ zip keys vals
+        let backward = Map.fromList $ zip vals keys
+        forward `Map.isInverseOf` backward
+
+  it "fails when different keys map to one value" $
+    property $
+      \(NonNegative (x :: Int)) (Positive (n :: Int)) -> do
+        let keys = take (n + 2) [x ..]
+        let vals = even <$> keys
+        let forward = Map.fromList $ zip keys vals
+        let backward = Map.fromList $ zip vals keys
+        not $ forward `Map.isInverseOf` backward
+
+  it "passes some trivial examples as a smoke test" $ do
+    let fwd = Map.fromList @Int @Bool
+    let bwd = Map.fromList @Bool @Int
+    and
+      [ fwd [] `Map.isInverseOf` bwd [],
+        not $ fwd [(1, True)] `Map.isInverseOf` bwd [],
+        not $ fwd [] `Map.isInverseOf` bwd [(True, 1)],
+        fwd [(1, True)] `Map.isInverseOf` bwd [(True, 1)],
+        not $ fwd [(2, True)] `Map.isInverseOf` bwd [(True, 1)]
+      ]

server/src-test/Main.hs

@@ -8,6 +8,7 @@ import Data.Aeson qualified as A
 import Data.ByteString.Lazy.Char8 qualified as BL
 import Data.ByteString.Lazy.UTF8 qualified as LBS
 import Data.Environment qualified as Env
+import Data.HashMap.Strict.ExtendedSpec qualified as HashMapExtendedSpec
 import Data.NonNegativeIntSpec qualified as NonNegetiveIntSpec
 import Data.Parser.CacheControlSpec qualified as CacheControlParser
 import Data.Parser.JSONPathSpec qualified as JsonPath
@@ -82,6 +83,7 @@ main =
 
 unitSpecs :: Spec
 unitSpecs = do
+  describe "Data.HashMap.Strict.ExtendedSpec" HashMapExtendedSpec.spec
   describe "Data.NonNegativeInt" NonNegetiveIntSpec.spec
   describe "Data.Parser.CacheControl" CacheControlParser.spec
   describe "Data.Parser.JSONPath" JsonPath.spec
@@ -149,7 +151,7 @@ buildPostgresSpecs = do
 
       setupCacheRef = do
         httpManager <- HTTP.newManager HTTP.tlsManagerSettings
-        let sqlGenCtx = SQLGenCtx False False
+        let sqlGenCtx = SQLGenCtx False False False
             maintenanceMode = MaintenanceModeDisabled
             readOnlyMode = ReadOnlyModeDisabled
             serverConfigCtx =

server/tests-hspec/Harness/Constants.hs

@@ -225,7 +225,8 @@ serveOptions =
       soGracefulShutdownTimeout = 0, -- Don't wait to shutdown.
       soWebsocketConnectionInitTimeout = defaultWSConnectionInitTimeout,
       soEventingMode = EventingEnabled,
-      soReadOnlyMode = ReadOnlyModeDisabled
+      soReadOnlyMode = ReadOnlyModeDisabled,
+      soOptimizePermissionFilters = False
     }
 
 -- | Use the below to show messages.

server/tests/integration/Hasura/Test/App.hs

@@ -347,5 +347,6 @@ defaultRawServeOptions =
       rsoExperimentalFeatures = Nothing,
       rsoEventsFetchBatchSize = Nothing,
       rsoGracefulShutdownTimeout = Nothing,
-      rsoWebSocketConnectionInitTimeout = Nothing
+      rsoWebSocketConnectionInitTimeout = Nothing,
+      rsoOptimizePermissionFilters = Nothing
     }