mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
342391f39d
This upgrades the version of Ormolu required by the HGE repository to v0.5.0.1, and reformats all code accordingly. Ormolu v0.5 reformats code that uses infix operators. This is mostly useful, adding newlines and indentation to make it clear which operators are applied first, but in some cases, it's unpleasant. To make this easier on the eyes, I had to do the following: * Add a few fixity declarations (search for `infix`) * Add parentheses to make precedence clear, allowing Ormolu to keep everything on one line * Rename `relevantEq` to `(==~)` in #6651 and set it to `infix 4` * Add a few _.ormolu_ files (thanks to @hallettj for helping me get started), mostly for Autodocodec operators that don't have explicit fixity declarations In general, I think these changes are quite reasonable. They mostly affect indentation. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6675 GitOrigin-RevId: cd47d87f1d089fb0bc9dcbbe7798dbceedcd7d83
130 lines
3.6 KiB
Haskell
130 lines
3.6 KiB
Haskell
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
module Hasura.RQL.DDL.Permission.Internal
|
|
( CreatePerm (..),
|
|
DropPerm (..),
|
|
permissionIsDefined,
|
|
assertPermDefined,
|
|
interpColSpec,
|
|
getDepHeadersFromVal,
|
|
getDependentHeaders,
|
|
procBoolExp,
|
|
)
|
|
where
|
|
|
|
import Control.Lens hiding ((.=))
|
|
import Data.Aeson.KeyMap qualified as KM
|
|
import Data.Aeson.Types
|
|
import Data.HashMap.Strict qualified as M
|
|
import Data.HashSet qualified as Set
|
|
import Data.Text qualified as T
|
|
import Data.Text.Extended
|
|
import Hasura.Backends.Postgres.Translate.BoolExp
|
|
import Hasura.Base.Error
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.IR.BoolExp
|
|
import Hasura.RQL.Types.Backend
|
|
import Hasura.RQL.Types.BoolExp
|
|
import Hasura.RQL.Types.Common
|
|
import Hasura.RQL.Types.Metadata.Backend
|
|
import Hasura.RQL.Types.Permission
|
|
import Hasura.RQL.Types.Relationships.Local
|
|
import Hasura.RQL.Types.SchemaCache
|
|
import Hasura.RQL.Types.SchemaCacheTypes
|
|
import Hasura.RQL.Types.Table
|
|
import Hasura.Server.Utils
|
|
import Hasura.Session
|
|
|
|
-- | Intrepet a 'PermColSpec' column specification, which can either refer to a
|
|
-- list of named columns or all columns.
|
|
interpColSpec :: [Column b] -> PermColSpec b -> [Column b]
|
|
interpColSpec _ (PCCols cols) = cols
|
|
interpColSpec allColumns PCStar = allColumns
|
|
|
|
permissionIsDefined ::
|
|
PermType -> RolePermInfo backend -> Bool
|
|
permissionIsDefined pt rpi = isJust
|
|
case pt of
|
|
PTSelect -> rpi ^. permSel $> ()
|
|
PTInsert -> rpi ^. permIns $> ()
|
|
PTUpdate -> rpi ^. permUpd $> ()
|
|
PTDelete -> rpi ^. permDel $> ()
|
|
|
|
assertPermDefined ::
|
|
(Backend backend, MonadError QErr m) =>
|
|
RoleName ->
|
|
PermType ->
|
|
TableInfo backend ->
|
|
m ()
|
|
assertPermDefined role pt tableInfo =
|
|
unless (any (permissionIsDefined pt) rpi) $
|
|
throw400 PermissionDenied $
|
|
"'"
|
|
<> tshow pt
|
|
<> "'"
|
|
<> " permission on "
|
|
<> tableInfoName tableInfo
|
|
<<> " for role "
|
|
<> role
|
|
<<> " does not exist"
|
|
where
|
|
rpi = M.lookup role $ _tiRolePermInfoMap tableInfo
|
|
|
|
newtype CreatePerm a b = CreatePerm (WithTable b (PermDef b a))
|
|
|
|
deriving instance (Backend b, FromJSON (PermDef b a)) => FromJSON (CreatePerm a b)
|
|
|
|
data CreatePermP1Res a = CreatePermP1Res
|
|
{ cprInfo :: a,
|
|
cprDeps :: [SchemaDependency]
|
|
}
|
|
deriving (Show, Eq)
|
|
|
|
procBoolExp ::
|
|
( QErrM m,
|
|
TableCoreInfoRM b m,
|
|
BackendMetadata b,
|
|
GetAggregationPredicatesDeps b
|
|
) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
FieldInfoMap (FieldInfo b) ->
|
|
BoolExp b ->
|
|
m (AnnBoolExpPartialSQL b, [SchemaDependency])
|
|
procBoolExp source tn fieldInfoMap be = do
|
|
let rhsParser = BoolExpRHSParser parseCollectableType PSESession
|
|
abe <- annBoolExp rhsParser tn fieldInfoMap $ unBoolExp be
|
|
let deps = getBoolExpDeps source tn abe
|
|
return (abe, deps)
|
|
|
|
getDepHeadersFromVal :: Value -> [Text]
|
|
getDepHeadersFromVal val = case val of
|
|
Object o -> parseObject o
|
|
_ -> parseOnlyString val
|
|
where
|
|
parseOnlyString v = case v of
|
|
(String t)
|
|
| isSessionVariable t -> [T.toLower t]
|
|
| isReqUserId t -> [userIdHeader]
|
|
| otherwise -> []
|
|
_ -> []
|
|
parseObject o =
|
|
concatMap getDepHeadersFromVal (KM.elems o)
|
|
|
|
getDependentHeaders :: BoolExp b -> HashSet Text
|
|
getDependentHeaders (BoolExp boolExp) =
|
|
Set.fromList $ flip foldMap boolExp $ \(ColExp _ v) -> getDepHeadersFromVal v
|
|
|
|
data DropPerm b = DropPerm
|
|
{ dipSource :: SourceName,
|
|
dipTable :: TableName b,
|
|
dipRole :: RoleName
|
|
}
|
|
|
|
instance (Backend b) => FromJSON (DropPerm b) where
|
|
parseJSON = withObject "DropPerm" $ \o ->
|
|
DropPerm
|
|
<$> o .:? "source" .!= defaultSource
|
|
<*> o .: "table"
|
|
<*> o .: "role"
|