{-# 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 :: [Column b] -> PermColSpec b -> [Column b]
interpColSpec [Column b]
_ (PCCols [Column b]
cols) = [Column b]
cols
interpColSpec [Column b]
allColumns PermColSpec b
PCStar = [Column b]
allColumns

permissionIsDefined ::
  PermType -> RolePermInfo backend -> Bool
permissionIsDefined :: PermType -> RolePermInfo backend -> Bool
permissionIsDefined PermType
pt RolePermInfo backend
rpi = Maybe () -> Bool
forall a. Maybe a -> Bool
isJust
  case PermType
pt of
    PermType
PTSelect -> RolePermInfo backend
rpi RolePermInfo backend
-> Getting
     (Maybe (SelPermInfo backend))
     (RolePermInfo backend)
     (Maybe (SelPermInfo backend))
-> Maybe (SelPermInfo backend)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (SelPermInfo backend))
  (RolePermInfo backend)
  (Maybe (SelPermInfo backend))
forall (b :: BackendType).
Lens' (RolePermInfo b) (Maybe (SelPermInfo b))
permSel Maybe (SelPermInfo backend) -> () -> Maybe ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
    PermType
PTInsert -> RolePermInfo backend
rpi RolePermInfo backend
-> Getting
     (Maybe (InsPermInfo backend))
     (RolePermInfo backend)
     (Maybe (InsPermInfo backend))
-> Maybe (InsPermInfo backend)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (InsPermInfo backend))
  (RolePermInfo backend)
  (Maybe (InsPermInfo backend))
forall (b :: BackendType).
Lens' (RolePermInfo b) (Maybe (InsPermInfo b))
permIns Maybe (InsPermInfo backend) -> () -> Maybe ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
    PermType
PTUpdate -> RolePermInfo backend
rpi RolePermInfo backend
-> Getting
     (Maybe (UpdPermInfo backend))
     (RolePermInfo backend)
     (Maybe (UpdPermInfo backend))
-> Maybe (UpdPermInfo backend)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (UpdPermInfo backend))
  (RolePermInfo backend)
  (Maybe (UpdPermInfo backend))
forall (b :: BackendType).
Lens' (RolePermInfo b) (Maybe (UpdPermInfo b))
permUpd Maybe (UpdPermInfo backend) -> () -> Maybe ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
    PermType
PTDelete -> RolePermInfo backend
rpi RolePermInfo backend
-> Getting
     (Maybe (DelPermInfo backend))
     (RolePermInfo backend)
     (Maybe (DelPermInfo backend))
-> Maybe (DelPermInfo backend)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (DelPermInfo backend))
  (RolePermInfo backend)
  (Maybe (DelPermInfo backend))
forall (b :: BackendType).
Lens' (RolePermInfo b) (Maybe (DelPermInfo b))
permDel Maybe (DelPermInfo backend) -> () -> Maybe ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

assertPermDefined ::
  (Backend backend, MonadError QErr m) =>
  RoleName ->
  PermType ->
  TableInfo backend ->
  m ()
assertPermDefined :: RoleName -> PermType -> TableInfo backend -> m ()
assertPermDefined RoleName
role PermType
pt TableInfo backend
tableInfo =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
-> (RolePermInfo backend -> Bool)
-> Maybe (RolePermInfo backend)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (PermType -> RolePermInfo backend -> Bool
forall (backend :: BackendType).
PermType -> RolePermInfo backend -> Bool
permissionIsDefined PermType
pt) Maybe (RolePermInfo backend)
rpi) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
PermissionDenied (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PermType -> Text
forall a. Show a => a -> Text
tshow PermType
pt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" permission on "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableInfo backend -> TableName backend
forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName TableInfo backend
tableInfo
        TableName backend -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for role "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
role
        RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"
  where
    rpi :: Maybe (RolePermInfo backend)
rpi = RoleName
-> HashMap RoleName (RolePermInfo backend)
-> Maybe (RolePermInfo backend)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup RoleName
role (HashMap RoleName (RolePermInfo backend)
 -> Maybe (RolePermInfo backend))
-> HashMap RoleName (RolePermInfo backend)
-> Maybe (RolePermInfo backend)
forall a b. (a -> b) -> a -> b
$ TableInfo backend -> HashMap RoleName (RolePermInfo backend)
forall (b :: BackendType). TableInfo b -> RolePermInfoMap b
_tiRolePermInfoMap TableInfo backend
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
  { CreatePermP1Res a -> a
cprInfo :: a,
    CreatePermP1Res a -> [SchemaDependency]
cprDeps :: [SchemaDependency]
  }
  deriving (Int -> CreatePermP1Res a -> ShowS
[CreatePermP1Res a] -> ShowS
CreatePermP1Res a -> String
(Int -> CreatePermP1Res a -> ShowS)
-> (CreatePermP1Res a -> String)
-> ([CreatePermP1Res a] -> ShowS)
-> Show (CreatePermP1Res a)
forall a. Show a => Int -> CreatePermP1Res a -> ShowS
forall a. Show a => [CreatePermP1Res a] -> ShowS
forall a. Show a => CreatePermP1Res a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePermP1Res a] -> ShowS
$cshowList :: forall a. Show a => [CreatePermP1Res a] -> ShowS
show :: CreatePermP1Res a -> String
$cshow :: forall a. Show a => CreatePermP1Res a -> String
showsPrec :: Int -> CreatePermP1Res a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CreatePermP1Res a -> ShowS
Show, CreatePermP1Res a -> CreatePermP1Res a -> Bool
(CreatePermP1Res a -> CreatePermP1Res a -> Bool)
-> (CreatePermP1Res a -> CreatePermP1Res a -> Bool)
-> Eq (CreatePermP1Res a)
forall a. Eq a => CreatePermP1Res a -> CreatePermP1Res a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePermP1Res a -> CreatePermP1Res a -> Bool
$c/= :: forall a. Eq a => CreatePermP1Res a -> CreatePermP1Res a -> Bool
== :: CreatePermP1Res a -> CreatePermP1Res a -> Bool
$c== :: forall a. Eq a => CreatePermP1Res a -> CreatePermP1Res a -> Bool
Eq)

procBoolExp ::
  ( QErrM m,
    TableCoreInfoRM b m,
    BackendMetadata b,
    GetAggregationPredicatesDeps b
  ) =>
  SourceName ->
  TableName b ->
  FieldInfoMap (FieldInfo b) ->
  BoolExp b ->
  m (AnnBoolExpPartialSQL b, [SchemaDependency])
procBoolExp :: SourceName
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> BoolExp b
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
procBoolExp SourceName
source TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap BoolExp b
be = do
  let rhsParser :: BoolExpRHSParser b m (PartialSQLExp b)
rhsParser = ValueParser b m (PartialSQLExp b)
-> PartialSQLExp b -> BoolExpRHSParser b m (PartialSQLExp b)
forall (b :: BackendType) (m :: * -> *) v.
ValueParser b m v -> v -> BoolExpRHSParser b m v
BoolExpRHSParser ValueParser b m (PartialSQLExp b)
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m) =>
CollectableType (ColumnType b) -> Value -> m (PartialSQLExp b)
parseCollectableType PartialSQLExp b
forall (backend :: BackendType). PartialSQLExp backend
PSESession
  AnnBoolExpPartialSQL b
abe <- BoolExpRHSParser b m (PartialSQLExp b)
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExpPartialSQL b)
forall (m :: * -> *) (b :: BackendType) v.
(QErrM m, TableCoreInfoRM b m, BackendMetadata b) =>
BoolExpRHSParser b m v
-> TableName b
-> FieldInfoMap (FieldInfo b)
-> GBoolExp b ColExp
-> m (AnnBoolExp b v)
annBoolExp BoolExpRHSParser b m (PartialSQLExp b)
rhsParser TableName b
tn FieldInfoMap (FieldInfo b)
fieldInfoMap (GBoolExp b ColExp -> m (AnnBoolExpPartialSQL b))
-> GBoolExp b ColExp -> m (AnnBoolExpPartialSQL b)
forall a b. (a -> b) -> a -> b
$ BoolExp b -> GBoolExp b ColExp
forall (b :: BackendType). BoolExp b -> GBoolExp b ColExp
unBoolExp BoolExp b
be
  let deps :: [SchemaDependency]
deps = SourceName
-> TableName b -> AnnBoolExpPartialSQL b -> [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
SourceName
-> TableName b -> AnnBoolExpPartialSQL b -> [SchemaDependency]
getBoolExpDeps SourceName
source TableName b
tn AnnBoolExpPartialSQL b
abe
  (AnnBoolExpPartialSQL b, [SchemaDependency])
-> m (AnnBoolExpPartialSQL b, [SchemaDependency])
forall (m :: * -> *) a. Monad m => a -> m a
return (AnnBoolExpPartialSQL b
abe, [SchemaDependency]
deps)

getDepHeadersFromVal :: Value -> [Text]
getDepHeadersFromVal :: Value -> [Text]
getDepHeadersFromVal Value
val = case Value
val of
  Object Object
o -> Object -> [Text]
parseObject Object
o
  Value
_ -> Value -> [Text]
parseOnlyString Value
val
  where
    parseOnlyString :: Value -> [Text]
parseOnlyString Value
v = case Value
v of
      (String Text
t)
        | Text -> Bool
isSessionVariable Text
t -> [Text -> Text
T.toLower Text
t]
        | Text -> Bool
isReqUserId Text
t -> [Text
forall a. IsString a => a
userIdHeader]
        | Bool
otherwise -> []
      Value
_ -> []
    parseObject :: Object -> [Text]
parseObject Object
o =
      (Value -> [Text]) -> [Value] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> [Text]
getDepHeadersFromVal (Object -> [Value]
forall v. KeyMap v -> [v]
KM.elems Object
o)

getDependentHeaders :: BoolExp b -> HashSet Text
getDependentHeaders :: BoolExp b -> HashSet Text
getDependentHeaders (BoolExp GBoolExp b ColExp
boolExp) =
  [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([Text] -> HashSet Text) -> [Text] -> HashSet Text
forall a b. (a -> b) -> a -> b
$ ((ColExp -> [Text]) -> GBoolExp b ColExp -> [Text])
-> GBoolExp b ColExp -> (ColExp -> [Text]) -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ColExp -> [Text]) -> GBoolExp b ColExp -> [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GBoolExp b ColExp
boolExp ((ColExp -> [Text]) -> [Text]) -> (ColExp -> [Text]) -> [Text]
forall a b. (a -> b) -> a -> b
$ \(ColExp FieldName
_ Value
v) -> Value -> [Text]
getDepHeadersFromVal Value
v

data DropPerm b = DropPerm
  { DropPerm b -> SourceName
dipSource :: SourceName,
    DropPerm b -> TableName b
dipTable :: TableName b,
    DropPerm b -> RoleName
dipRole :: RoleName
  }

instance (Backend b) => FromJSON (DropPerm b) where
  parseJSON :: Value -> Parser (DropPerm b)
parseJSON = String
-> (Object -> Parser (DropPerm b)) -> Value -> Parser (DropPerm b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DropPerm" ((Object -> Parser (DropPerm b)) -> Value -> Parser (DropPerm b))
-> (Object -> Parser (DropPerm b)) -> Value -> Parser (DropPerm b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName -> TableName b -> RoleName -> DropPerm b
forall (b :: BackendType).
SourceName -> TableName b -> RoleName -> DropPerm b
DropPerm
      (SourceName -> TableName b -> RoleName -> DropPerm b)
-> Parser SourceName
-> Parser (TableName b -> RoleName -> DropPerm b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser (TableName b -> RoleName -> DropPerm b)
-> Parser (TableName b) -> Parser (RoleName -> DropPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser (RoleName -> DropPerm b)
-> Parser RoleName -> Parser (DropPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser RoleName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role"