mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
11a454c2d6
This commit applies ormolu to the whole Haskell code base by running `make format`. For in-flight branches, simply merging changes from `main` will result in merge conflicts. To avoid this, update your branch using the following instructions. Replace `<format-commit>` by the hash of *this* commit. $ git checkout my-feature-branch $ git merge <format-commit>^ # and resolve conflicts normally $ make format $ git commit -a -m "reformat with ormolu" $ git merge -s ours post-ormolu https://github.com/hasura/graphql-engine-mono/pull/2404 GitOrigin-RevId: 75049f5c12f430c615eafb4c6b8e83e371e01c8e
116 lines
3.3 KiB
Haskell
116 lines
3.3 KiB
Haskell
module Hasura.RQL.DDL.Permission.Internal where
|
|
|
|
import Control.Lens hiding ((.=))
|
|
import Data.Aeson.Types
|
|
import Data.HashMap.Strict qualified as M
|
|
import Data.HashSet qualified as Set
|
|
import Data.Kind (Type)
|
|
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.Types
|
|
import Hasura.Server.Utils
|
|
import Hasura.Session
|
|
|
|
convColSpec :: FieldInfoMap (FieldInfo b) -> PermColSpec b -> [Column b]
|
|
convColSpec _ (PCCols cols) = cols
|
|
convColSpec cim PCStar = map pgiColumn $ getCols cim
|
|
|
|
permissionIsDefined ::
|
|
Maybe (RolePermInfo backend) -> PermAccessor backend a -> Bool
|
|
permissionIsDefined rpi pa =
|
|
isJust $ join $ rpi ^? _Just . permAccToLens pa
|
|
|
|
assertPermDefined ::
|
|
(Backend backend, MonadError QErr m) =>
|
|
RoleName ->
|
|
PermAccessor backend a ->
|
|
TableInfo backend ->
|
|
m ()
|
|
assertPermDefined role pa tableInfo =
|
|
unless (permissionIsDefined rpi pa) $
|
|
throw400 PermissionDenied $
|
|
mconcat
|
|
[ "'" <> tshow (permAccToType pa) <> "'",
|
|
" permission on " <>> tableInfoName tableInfo,
|
|
" for role " <>> role,
|
|
" does not exist"
|
|
]
|
|
where
|
|
rpi = M.lookup role $ _tiRolePermInfoMap tableInfo
|
|
|
|
askPermInfo ::
|
|
(Backend backend, MonadError QErr m) =>
|
|
TableInfo backend ->
|
|
RoleName ->
|
|
PermAccessor backend c ->
|
|
m c
|
|
askPermInfo tabInfo roleName pa =
|
|
(M.lookup roleName rpim >>= (^. permAccToLens pa))
|
|
`onNothing` throw400
|
|
PermissionDenied
|
|
( mconcat
|
|
[ pt <> " permission on " <>> tableInfoName tabInfo,
|
|
" for role " <>> roleName,
|
|
" does not exist"
|
|
]
|
|
)
|
|
where
|
|
pt = permTypeToCode $ permAccToType pa
|
|
rpim = _tiRolePermInfoMap tabInfo
|
|
|
|
newtype CreatePerm a b = CreatePerm (WithTable b (PermDef (a b)))
|
|
deriving newtype (FromJSON)
|
|
|
|
data CreatePermP1Res a = CreatePermP1Res
|
|
{ cprInfo :: !a,
|
|
cprDeps :: ![SchemaDependency]
|
|
}
|
|
deriving (Show, Eq)
|
|
|
|
procBoolExp ::
|
|
(QErrM m, TableCoreInfoRM b m, BackendMetadata 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 (M.elems o)
|
|
|
|
getDependentHeaders :: BoolExp b -> HashSet Text
|
|
getDependentHeaders (BoolExp boolExp) =
|
|
Set.fromList $ flip foldMap boolExp $ \(ColExp _ v) -> getDepHeadersFromVal v
|
|
|
|
data DropPerm (a :: BackendType -> Type) b = DropPerm
|
|
{ dipSource :: !SourceName,
|
|
dipTable :: !(TableName b),
|
|
dipRole :: !RoleName
|
|
}
|
|
|
|
instance (Backend b) => FromJSON (DropPerm a b) where
|
|
parseJSON = withObject "DropPerm" $ \o ->
|
|
DropPerm
|
|
<$> o .:? "source" .!= defaultSource
|
|
<*> o .: "table"
|
|
<*> o .: "role"
|