graphql-engine/server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs
Robert 11a454c2d6 server, pro: actually reformat the code-base using ormolu
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
2021-09-23 22:57:37 +00:00

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"