mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
eab4f75212
This introduces an `ErrorMessage` newtype which wraps `Text` in a manner which is designed to be easy to construct, and difficult to deconstruct. It provides functionality similar to `Data.Text.Extended`, but designed _only_ for error messages. Error messages are constructed through `fromString`, concatenation, or the `toErrorValue` function, which is designed to be overridden for all meaningful domain types that might show up in an error message. Notably, there are not and should never be instances of `ToErrorValue` for `String`, `Text`, `Int`, etc. This is so that we correctly represent the value in a way that is specific to its type. For example, all `Name` values (from the _graphql-parser-hs_ library) are single-quoted now; no exceptions. I have mostly had to add `instance ToErrorValue` for various backend types (and also add newtypes where necessary). Some of these are not strictly necessary for this changeset, as I had bigger aspirations when I started. These aspirations have been tempered by trying and failing twice. As such, in this changeset, I have started by introducing this type to the `parseError` and `parseErrorWith` functions. In the future, I would like to extend this to the `QErr` record and the various `throwError` functions, but this is a much larger task and should probably be done in stages. For now, `toErrorMessage` and `fromErrorMessage` are provided for conversion to and from `Text`, but the intent is to stop exporting these once all error messages are converted to the new type. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5018 GitOrigin-RevId: 84b37e238992e4312255a87ca44f41af65e2d89a
123 lines
3.5 KiB
Haskell
123 lines
3.5 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.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 (maybe False (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) =>
|
|
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"
|