{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasura.RQL.Types.Permission
  ( DelPerm (..),
    DelPermDef,
    InsPerm (..),
    InsPermDef,
    PermColSpec (..),
    PermDef (..),
    PermType (..),
    SelPerm (..),
    SelPermDef,
    UpdPerm (..),
    UpdPermDef,
    pdComment,
    pdPermission,
    pdRole,
    permTypeToCode,
    PermDefPermission (..),
    unPermDefPermission,
    reflectPermDefPermission,
    SubscriptionRootFieldType (..),
    QueryRootFieldType (..),
    AllowedRootFields (..),
    isRootFieldAllowed,
  )
where

import Control.Lens (makeLenses)
import Data.Aeson
import Data.Aeson.Casing (snakeCase)
import Data.Aeson.TH
import Data.HashSet qualified as Set
import Data.Hashable
import Data.Kind (Type)
import Data.Text qualified as T
import Database.PG.Query qualified as Q
import Hasura.Incremental (Cacheable (..))
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.SQL.Backend
import Hasura.Session
import PostgreSQL.Binary.Decoding qualified as PD

data PermType
  = PTInsert
  | PTSelect
  | PTUpdate
  | PTDelete
  deriving (PermType -> PermType -> Bool
(PermType -> PermType -> Bool)
-> (PermType -> PermType -> Bool) -> Eq PermType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PermType -> PermType -> Bool
$c/= :: PermType -> PermType -> Bool
== :: PermType -> PermType -> Bool
$c== :: PermType -> PermType -> Bool
Eq, (forall x. PermType -> Rep PermType x)
-> (forall x. Rep PermType x -> PermType) -> Generic PermType
forall x. Rep PermType x -> PermType
forall x. PermType -> Rep PermType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PermType x -> PermType
$cfrom :: forall x. PermType -> Rep PermType x
Generic)

instance NFData PermType

instance Cacheable PermType

instance Q.FromCol PermType where
  fromCol :: Maybe ByteString -> Either Text PermType
fromCol Maybe ByteString
bs = (Value PermType -> Maybe ByteString -> Either Text PermType)
-> Maybe ByteString -> Value PermType -> Either Text PermType
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value PermType -> Maybe ByteString -> Either Text PermType
forall a. Value a -> Maybe ByteString -> Either Text a
Q.fromColHelper Maybe ByteString
bs (Value PermType -> Either Text PermType)
-> Value PermType -> Either Text PermType
forall a b. (a -> b) -> a -> b
$
    (Text -> Maybe PermType) -> Value PermType
forall a. (Text -> Maybe a) -> Value a
PD.enum ((Text -> Maybe PermType) -> Value PermType)
-> (Text -> Maybe PermType) -> Value PermType
forall a b. (a -> b) -> a -> b
$ \case
      Text
"insert" -> PermType -> Maybe PermType
forall a. a -> Maybe a
Just PermType
PTInsert
      Text
"update" -> PermType -> Maybe PermType
forall a. a -> Maybe a
Just PermType
PTUpdate
      Text
"select" -> PermType -> Maybe PermType
forall a. a -> Maybe a
Just PermType
PTSelect
      Text
"delete" -> PermType -> Maybe PermType
forall a. a -> Maybe a
Just PermType
PTDelete
      Text
_ -> Maybe PermType
forall a. Maybe a
Nothing

permTypeToCode :: PermType -> Text
permTypeToCode :: PermType -> Text
permTypeToCode PermType
PTInsert = Text
"insert"
permTypeToCode PermType
PTSelect = Text
"select"
permTypeToCode PermType
PTUpdate = Text
"update"
permTypeToCode PermType
PTDelete = Text
"delete"

instance Hashable PermType where
  hashWithSalt :: Int -> PermType -> Int
hashWithSalt Int
salt PermType
a = Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ PermType -> Text
permTypeToCode PermType
a

instance Show PermType where
  show :: PermType -> String
show PermType
PTInsert = String
"insert"
  show PermType
PTSelect = String
"select"
  show PermType
PTUpdate = String
"update"
  show PermType
PTDelete = String
"delete"

instance FromJSON PermType where
  parseJSON :: Value -> Parser PermType
parseJSON (String Text
"insert") = PermType -> Parser PermType
forall (m :: * -> *) a. Monad m => a -> m a
return PermType
PTInsert
  parseJSON (String Text
"select") = PermType -> Parser PermType
forall (m :: * -> *) a. Monad m => a -> m a
return PermType
PTSelect
  parseJSON (String Text
"update") = PermType -> Parser PermType
forall (m :: * -> *) a. Monad m => a -> m a
return PermType
PTUpdate
  parseJSON (String Text
"delete") = PermType -> Parser PermType
forall (m :: * -> *) a. Monad m => a -> m a
return PermType
PTDelete
  parseJSON Value
_ =
    String -> Parser PermType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"perm_type should be one of 'insert', 'select', 'update', 'delete'"

instance ToJSON PermType where
  toJSON :: PermType -> Value
toJSON = Text -> Value
String (Text -> Value) -> (PermType -> Text) -> PermType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PermType -> Text
permTypeToCode

data PermColSpec b
  = PCStar
  | PCCols [Column b]
  deriving ((forall x. PermColSpec b -> Rep (PermColSpec b) x)
-> (forall x. Rep (PermColSpec b) x -> PermColSpec b)
-> Generic (PermColSpec b)
forall x. Rep (PermColSpec b) x -> PermColSpec b
forall x. PermColSpec b -> Rep (PermColSpec b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (PermColSpec b) x -> PermColSpec b
forall (b :: BackendType) x. PermColSpec b -> Rep (PermColSpec b) x
$cto :: forall (b :: BackendType) x. Rep (PermColSpec b) x -> PermColSpec b
$cfrom :: forall (b :: BackendType) x. PermColSpec b -> Rep (PermColSpec b) x
Generic)

deriving instance (Backend b) => Show (PermColSpec b)

deriving instance (Backend b) => Eq (PermColSpec b)

instance (Backend b) => Cacheable (PermColSpec b)

instance (Backend b) => FromJSON (PermColSpec b) where
  parseJSON :: Value -> Parser (PermColSpec b)
parseJSON (String Text
"*") = PermColSpec b -> Parser (PermColSpec b)
forall (m :: * -> *) a. Monad m => a -> m a
return PermColSpec b
forall (b :: BackendType). PermColSpec b
PCStar
  parseJSON Value
x = [Column b] -> PermColSpec b
forall (b :: BackendType). [Column b] -> PermColSpec b
PCCols ([Column b] -> PermColSpec b)
-> Parser [Column b] -> Parser (PermColSpec b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Column b]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x

instance (Backend b) => ToJSON (PermColSpec b) where
  toJSON :: PermColSpec b -> Value
toJSON (PCCols [Column b]
cols) = [Column b] -> Value
forall a. ToJSON a => a -> Value
toJSON [Column b]
cols
  toJSON PermColSpec b
PCStar = Value
"*"

data PermDef (b :: BackendType) (perm :: BackendType -> Type) = PermDef
  { PermDef b perm -> RoleName
_pdRole :: RoleName,
    PermDef b perm -> PermDefPermission b perm
_pdPermission :: PermDefPermission b perm,
    PermDef b perm -> Maybe Text
_pdComment :: Maybe T.Text
  }
  deriving (Int -> PermDef b perm -> ShowS
[PermDef b perm] -> ShowS
PermDef b perm -> String
(Int -> PermDef b perm -> ShowS)
-> (PermDef b perm -> String)
-> ([PermDef b perm] -> ShowS)
-> Show (PermDef b perm)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType) (perm :: BackendType -> *).
Backend b =>
Int -> PermDef b perm -> ShowS
forall (b :: BackendType) (perm :: BackendType -> *).
Backend b =>
[PermDef b perm] -> ShowS
forall (b :: BackendType) (perm :: BackendType -> *).
Backend b =>
PermDef b perm -> String
showList :: [PermDef b perm] -> ShowS
$cshowList :: forall (b :: BackendType) (perm :: BackendType -> *).
Backend b =>
[PermDef b perm] -> ShowS
show :: PermDef b perm -> String
$cshow :: forall (b :: BackendType) (perm :: BackendType -> *).
Backend b =>
PermDef b perm -> String
showsPrec :: Int -> PermDef b perm -> ShowS
$cshowsPrec :: forall (b :: BackendType) (perm :: BackendType -> *).
Backend b =>
Int -> PermDef b perm -> ShowS
Show, PermDef b perm -> PermDef b perm -> Bool
(PermDef b perm -> PermDef b perm -> Bool)
-> (PermDef b perm -> PermDef b perm -> Bool)
-> Eq (PermDef b perm)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType) (perm :: BackendType -> *).
Backend b =>
PermDef b perm -> PermDef b perm -> Bool
/= :: PermDef b perm -> PermDef b perm -> Bool
$c/= :: forall (b :: BackendType) (perm :: BackendType -> *).
Backend b =>
PermDef b perm -> PermDef b perm -> Bool
== :: PermDef b perm -> PermDef b perm -> Bool
$c== :: forall (b :: BackendType) (perm :: BackendType -> *).
Backend b =>
PermDef b perm -> PermDef b perm -> Bool
Eq, (forall x. PermDef b perm -> Rep (PermDef b perm) x)
-> (forall x. Rep (PermDef b perm) x -> PermDef b perm)
-> Generic (PermDef b perm)
forall x. Rep (PermDef b perm) x -> PermDef b perm
forall x. PermDef b perm -> Rep (PermDef b perm) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) (perm :: BackendType -> *) x.
Rep (PermDef b perm) x -> PermDef b perm
forall (b :: BackendType) (perm :: BackendType -> *) x.
PermDef b perm -> Rep (PermDef b perm) x
$cto :: forall (b :: BackendType) (perm :: BackendType -> *) x.
Rep (PermDef b perm) x -> PermDef b perm
$cfrom :: forall (b :: BackendType) (perm :: BackendType -> *) x.
PermDef b perm -> Rep (PermDef b perm) x
Generic)

instance (Backend b, Cacheable (perm b)) => Cacheable (PermDef b perm)

-- | The permission data as it appears in a 'PermDef'.
-- Since this type is a GADT it facilitates that values which are polymorphic
-- may re-discover its specific type of permission by case analysis.
--
-- The fact that permission types are tracked in types are more accidental than
-- intentional and something we want to move away from, see
-- https://github.com/hasura/graphql-engine-mono/issues/4076.
data PermDefPermission (b :: BackendType) (perm :: BackendType -> Type) where
  SelPerm' :: SelPerm b -> PermDefPermission b SelPerm
  InsPerm' :: InsPerm b -> PermDefPermission b InsPerm
  UpdPerm' :: UpdPerm b -> PermDefPermission b UpdPerm
  DelPerm' :: DelPerm b -> PermDefPermission b DelPerm

instance Backend b => FromJSON (PermDefPermission b SelPerm) where
  parseJSON :: Value -> Parser (PermDefPermission b SelPerm)
parseJSON = (SelPerm b -> PermDefPermission b SelPerm)
-> Parser (SelPerm b) -> Parser (PermDefPermission b SelPerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SelPerm b -> PermDefPermission b SelPerm
forall (b :: BackendType). SelPerm b -> PermDefPermission b SelPerm
SelPerm' (Parser (SelPerm b) -> Parser (PermDefPermission b SelPerm))
-> (Value -> Parser (SelPerm b))
-> Value
-> Parser (PermDefPermission b SelPerm)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (SelPerm b)
forall a. FromJSON a => Value -> Parser a
parseJSON

instance Backend b => FromJSON (PermDefPermission b InsPerm) where
  parseJSON :: Value -> Parser (PermDefPermission b InsPerm)
parseJSON = (InsPerm b -> PermDefPermission b InsPerm)
-> Parser (InsPerm b) -> Parser (PermDefPermission b InsPerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InsPerm b -> PermDefPermission b InsPerm
forall (b :: BackendType). InsPerm b -> PermDefPermission b InsPerm
InsPerm' (Parser (InsPerm b) -> Parser (PermDefPermission b InsPerm))
-> (Value -> Parser (InsPerm b))
-> Value
-> Parser (PermDefPermission b InsPerm)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (InsPerm b)
forall a. FromJSON a => Value -> Parser a
parseJSON

instance Backend b => FromJSON (PermDefPermission b UpdPerm) where
  parseJSON :: Value -> Parser (PermDefPermission b UpdPerm)
parseJSON = (UpdPerm b -> PermDefPermission b UpdPerm)
-> Parser (UpdPerm b) -> Parser (PermDefPermission b UpdPerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UpdPerm b -> PermDefPermission b UpdPerm
forall (b :: BackendType). UpdPerm b -> PermDefPermission b UpdPerm
UpdPerm' (Parser (UpdPerm b) -> Parser (PermDefPermission b UpdPerm))
-> (Value -> Parser (UpdPerm b))
-> Value
-> Parser (PermDefPermission b UpdPerm)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (UpdPerm b)
forall a. FromJSON a => Value -> Parser a
parseJSON

instance Backend b => FromJSON (PermDefPermission b DelPerm) where
  parseJSON :: Value -> Parser (PermDefPermission b DelPerm)
parseJSON = (DelPerm b -> PermDefPermission b DelPerm)
-> Parser (DelPerm b) -> Parser (PermDefPermission b DelPerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DelPerm b -> PermDefPermission b DelPerm
forall (b :: BackendType). DelPerm b -> PermDefPermission b DelPerm
DelPerm' (Parser (DelPerm b) -> Parser (PermDefPermission b DelPerm))
-> (Value -> Parser (DelPerm b))
-> Value
-> Parser (PermDefPermission b DelPerm)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (DelPerm b)
forall a. FromJSON a => Value -> Parser a
parseJSON

instance Backend b => ToJSON (PermDefPermission b perm) where
  toJSON :: PermDefPermission b perm -> Value
toJSON = \case
    SelPerm' SelPerm b
p -> SelPerm b -> Value
forall a. ToJSON a => a -> Value
toJSON SelPerm b
p
    InsPerm' InsPerm b
p -> InsPerm b -> Value
forall a. ToJSON a => a -> Value
toJSON InsPerm b
p
    UpdPerm' UpdPerm b
p -> UpdPerm b -> Value
forall a. ToJSON a => a -> Value
toJSON UpdPerm b
p
    DelPerm' DelPerm b
p -> DelPerm b -> Value
forall a. ToJSON a => a -> Value
toJSON DelPerm b
p

deriving stock instance Backend b => Show (PermDefPermission b perm)

deriving stock instance Backend b => Eq (PermDefPermission b perm)

instance Backend b => Cacheable (PermDefPermission b perm) where
  unchanged :: Accesses
-> PermDefPermission b perm -> PermDefPermission b perm -> Bool
unchanged Accesses
accesses (SelPerm' SelPerm b
p1) (SelPerm' SelPerm b
p2) = Accesses -> SelPerm b -> SelPerm b -> Bool
forall a. Cacheable a => Accesses -> a -> a -> Bool
unchanged Accesses
accesses SelPerm b
p1 SelPerm b
p2
  unchanged Accesses
accesses (InsPerm' InsPerm b
p1) (InsPerm' InsPerm b
p2) = Accesses -> InsPerm b -> InsPerm b -> Bool
forall a. Cacheable a => Accesses -> a -> a -> Bool
unchanged Accesses
accesses InsPerm b
p1 InsPerm b
p2
  unchanged Accesses
accesses (UpdPerm' UpdPerm b
p1) (UpdPerm' UpdPerm b
p2) = Accesses -> UpdPerm b -> UpdPerm b -> Bool
forall a. Cacheable a => Accesses -> a -> a -> Bool
unchanged Accesses
accesses UpdPerm b
p1 UpdPerm b
p2
  unchanged Accesses
accesses (DelPerm' DelPerm b
p1) (DelPerm' DelPerm b
p2) = Accesses -> DelPerm b -> DelPerm b -> Bool
forall a. Cacheable a => Accesses -> a -> a -> Bool
unchanged Accesses
accesses DelPerm b
p1 DelPerm b
p2

-----------------------------

unPermDefPermission :: PermDefPermission b perm -> perm b
unPermDefPermission :: PermDefPermission b perm -> perm b
unPermDefPermission = \case
  SelPerm' SelPerm b
p -> perm b
SelPerm b
p
  InsPerm' InsPerm b
p -> perm b
InsPerm b
p
  UpdPerm' UpdPerm b
p -> perm b
UpdPerm b
p
  DelPerm' DelPerm b
p -> perm b
DelPerm b
p

reflectPermDefPermission :: PermDefPermission b a -> PermType
reflectPermDefPermission :: PermDefPermission b a -> PermType
reflectPermDefPermission = \case
  SelPerm' SelPerm b
_ -> PermType
PTSelect
  InsPerm' InsPerm b
_ -> PermType
PTInsert
  UpdPerm' UpdPerm b
_ -> PermType
PTUpdate
  DelPerm' DelPerm b
_ -> PermType
PTDelete

instance (Backend b, ToJSON (perm b)) => ToJSON (PermDef b perm) where
  toJSON :: PermDef b perm -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (PermDef b perm -> [Pair]) -> PermDef b perm -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PermDef b perm -> [Pair]
forall a v. (ToAesonPairs a, KeyValue v) => a -> [v]
toAesonPairs

instance Backend b => ToAesonPairs (PermDef b perm) where
  toAesonPairs :: PermDef b perm -> [v]
toAesonPairs (PermDef RoleName
rn PermDefPermission b perm
perm Maybe Text
comment) =
    [ Key
"role" Key -> RoleName -> v
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RoleName
rn,
      Key
"permission" Key -> PermDefPermission b perm -> v
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PermDefPermission b perm
perm,
      Key
"comment" Key -> Maybe Text -> v
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
comment
    ]

data QueryRootFieldType
  = QRFTSelect
  | QRFTSelectByPk
  | QRFTSelectAggregate
  deriving stock (Int -> QueryRootFieldType -> ShowS
[QueryRootFieldType] -> ShowS
QueryRootFieldType -> String
(Int -> QueryRootFieldType -> ShowS)
-> (QueryRootFieldType -> String)
-> ([QueryRootFieldType] -> ShowS)
-> Show QueryRootFieldType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryRootFieldType] -> ShowS
$cshowList :: [QueryRootFieldType] -> ShowS
show :: QueryRootFieldType -> String
$cshow :: QueryRootFieldType -> String
showsPrec :: Int -> QueryRootFieldType -> ShowS
$cshowsPrec :: Int -> QueryRootFieldType -> ShowS
Show, QueryRootFieldType -> QueryRootFieldType -> Bool
(QueryRootFieldType -> QueryRootFieldType -> Bool)
-> (QueryRootFieldType -> QueryRootFieldType -> Bool)
-> Eq QueryRootFieldType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryRootFieldType -> QueryRootFieldType -> Bool
$c/= :: QueryRootFieldType -> QueryRootFieldType -> Bool
== :: QueryRootFieldType -> QueryRootFieldType -> Bool
$c== :: QueryRootFieldType -> QueryRootFieldType -> Bool
Eq, (forall x. QueryRootFieldType -> Rep QueryRootFieldType x)
-> (forall x. Rep QueryRootFieldType x -> QueryRootFieldType)
-> Generic QueryRootFieldType
forall x. Rep QueryRootFieldType x -> QueryRootFieldType
forall x. QueryRootFieldType -> Rep QueryRootFieldType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QueryRootFieldType x -> QueryRootFieldType
$cfrom :: forall x. QueryRootFieldType -> Rep QueryRootFieldType x
Generic)
  deriving anyclass (Eq QueryRootFieldType
Eq QueryRootFieldType
-> (Accesses -> QueryRootFieldType -> QueryRootFieldType -> Bool)
-> Cacheable QueryRootFieldType
Accesses -> QueryRootFieldType -> QueryRootFieldType -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses -> QueryRootFieldType -> QueryRootFieldType -> Bool
$cunchanged :: Accesses -> QueryRootFieldType -> QueryRootFieldType -> Bool
$cp1Cacheable :: Eq QueryRootFieldType
Cacheable, Int -> QueryRootFieldType -> Int
QueryRootFieldType -> Int
(Int -> QueryRootFieldType -> Int)
-> (QueryRootFieldType -> Int) -> Hashable QueryRootFieldType
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: QueryRootFieldType -> Int
$chash :: QueryRootFieldType -> Int
hashWithSalt :: Int -> QueryRootFieldType -> Int
$chashWithSalt :: Int -> QueryRootFieldType -> Int
Hashable, QueryRootFieldType -> ()
(QueryRootFieldType -> ()) -> NFData QueryRootFieldType
forall a. (a -> ()) -> NFData a
rnf :: QueryRootFieldType -> ()
$crnf :: QueryRootFieldType -> ()
NFData)

instance FromJSON QueryRootFieldType where
  parseJSON :: Value -> Parser QueryRootFieldType
parseJSON = Options -> Value -> Parser QueryRootFieldType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4}

instance ToJSON QueryRootFieldType where
  toJSON :: QueryRootFieldType -> Value
toJSON = Options -> QueryRootFieldType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4}

data SubscriptionRootFieldType
  = SRFTSelect
  | SRFTSelectByPk
  | SRFTSelectAggregate
  | SRFTSelectStream
  deriving stock (Int -> SubscriptionRootFieldType -> ShowS
[SubscriptionRootFieldType] -> ShowS
SubscriptionRootFieldType -> String
(Int -> SubscriptionRootFieldType -> ShowS)
-> (SubscriptionRootFieldType -> String)
-> ([SubscriptionRootFieldType] -> ShowS)
-> Show SubscriptionRootFieldType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubscriptionRootFieldType] -> ShowS
$cshowList :: [SubscriptionRootFieldType] -> ShowS
show :: SubscriptionRootFieldType -> String
$cshow :: SubscriptionRootFieldType -> String
showsPrec :: Int -> SubscriptionRootFieldType -> ShowS
$cshowsPrec :: Int -> SubscriptionRootFieldType -> ShowS
Show, SubscriptionRootFieldType -> SubscriptionRootFieldType -> Bool
(SubscriptionRootFieldType -> SubscriptionRootFieldType -> Bool)
-> (SubscriptionRootFieldType -> SubscriptionRootFieldType -> Bool)
-> Eq SubscriptionRootFieldType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubscriptionRootFieldType -> SubscriptionRootFieldType -> Bool
$c/= :: SubscriptionRootFieldType -> SubscriptionRootFieldType -> Bool
== :: SubscriptionRootFieldType -> SubscriptionRootFieldType -> Bool
$c== :: SubscriptionRootFieldType -> SubscriptionRootFieldType -> Bool
Eq, (forall x.
 SubscriptionRootFieldType -> Rep SubscriptionRootFieldType x)
-> (forall x.
    Rep SubscriptionRootFieldType x -> SubscriptionRootFieldType)
-> Generic SubscriptionRootFieldType
forall x.
Rep SubscriptionRootFieldType x -> SubscriptionRootFieldType
forall x.
SubscriptionRootFieldType -> Rep SubscriptionRootFieldType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SubscriptionRootFieldType x -> SubscriptionRootFieldType
$cfrom :: forall x.
SubscriptionRootFieldType -> Rep SubscriptionRootFieldType x
Generic)
  deriving anyclass (Eq SubscriptionRootFieldType
Eq SubscriptionRootFieldType
-> (Accesses
    -> SubscriptionRootFieldType -> SubscriptionRootFieldType -> Bool)
-> Cacheable SubscriptionRootFieldType
Accesses
-> SubscriptionRootFieldType -> SubscriptionRootFieldType -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses
-> SubscriptionRootFieldType -> SubscriptionRootFieldType -> Bool
$cunchanged :: Accesses
-> SubscriptionRootFieldType -> SubscriptionRootFieldType -> Bool
$cp1Cacheable :: Eq SubscriptionRootFieldType
Cacheable, Int -> SubscriptionRootFieldType -> Int
SubscriptionRootFieldType -> Int
(Int -> SubscriptionRootFieldType -> Int)
-> (SubscriptionRootFieldType -> Int)
-> Hashable SubscriptionRootFieldType
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SubscriptionRootFieldType -> Int
$chash :: SubscriptionRootFieldType -> Int
hashWithSalt :: Int -> SubscriptionRootFieldType -> Int
$chashWithSalt :: Int -> SubscriptionRootFieldType -> Int
Hashable, SubscriptionRootFieldType -> ()
(SubscriptionRootFieldType -> ())
-> NFData SubscriptionRootFieldType
forall a. (a -> ()) -> NFData a
rnf :: SubscriptionRootFieldType -> ()
$crnf :: SubscriptionRootFieldType -> ()
NFData)

instance FromJSON SubscriptionRootFieldType where
  parseJSON :: Value -> Parser SubscriptionRootFieldType
parseJSON = Options -> Value -> Parser SubscriptionRootFieldType
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4}

instance ToJSON SubscriptionRootFieldType where
  toJSON :: SubscriptionRootFieldType -> Value
toJSON = Options -> SubscriptionRootFieldType -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
defaultOptions {constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4}

-- Insert permission
data InsPerm (b :: BackendType) = InsPerm
  { InsPerm b -> BoolExp b
ipCheck :: BoolExp b,
    InsPerm b -> Maybe (ColumnValues b Value)
ipSet :: Maybe (ColumnValues b Value),
    InsPerm b -> Maybe (PermColSpec b)
ipColumns :: Maybe (PermColSpec b),
    InsPerm b -> Bool
ipBackendOnly :: Bool -- see Note [Backend only permissions]
  }
  deriving (Int -> InsPerm b -> ShowS
[InsPerm b] -> ShowS
InsPerm b -> String
(Int -> InsPerm b -> ShowS)
-> (InsPerm b -> String)
-> ([InsPerm b] -> ShowS)
-> Show (InsPerm b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType). Backend b => Int -> InsPerm b -> ShowS
forall (b :: BackendType). Backend b => [InsPerm b] -> ShowS
forall (b :: BackendType). Backend b => InsPerm b -> String
showList :: [InsPerm b] -> ShowS
$cshowList :: forall (b :: BackendType). Backend b => [InsPerm b] -> ShowS
show :: InsPerm b -> String
$cshow :: forall (b :: BackendType). Backend b => InsPerm b -> String
showsPrec :: Int -> InsPerm b -> ShowS
$cshowsPrec :: forall (b :: BackendType). Backend b => Int -> InsPerm b -> ShowS
Show, InsPerm b -> InsPerm b -> Bool
(InsPerm b -> InsPerm b -> Bool)
-> (InsPerm b -> InsPerm b -> Bool) -> Eq (InsPerm b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
InsPerm b -> InsPerm b -> Bool
/= :: InsPerm b -> InsPerm b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
InsPerm b -> InsPerm b -> Bool
== :: InsPerm b -> InsPerm b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
InsPerm b -> InsPerm b -> Bool
Eq, (forall x. InsPerm b -> Rep (InsPerm b) x)
-> (forall x. Rep (InsPerm b) x -> InsPerm b)
-> Generic (InsPerm b)
forall x. Rep (InsPerm b) x -> InsPerm b
forall x. InsPerm b -> Rep (InsPerm b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (InsPerm b) x -> InsPerm b
forall (b :: BackendType) x. InsPerm b -> Rep (InsPerm b) x
$cto :: forall (b :: BackendType) x. Rep (InsPerm b) x -> InsPerm b
$cfrom :: forall (b :: BackendType) x. InsPerm b -> Rep (InsPerm b) x
Generic)

instance Backend b => Cacheable (InsPerm b)

instance Backend b => FromJSON (InsPerm b) where
  parseJSON :: Value -> Parser (InsPerm b)
parseJSON = String
-> (Object -> Parser (InsPerm b)) -> Value -> Parser (InsPerm b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"InsPerm" ((Object -> Parser (InsPerm b)) -> Value -> Parser (InsPerm b))
-> (Object -> Parser (InsPerm b)) -> Value -> Parser (InsPerm b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    BoolExp b
-> Maybe (HashMap (Column b) Value)
-> Maybe (PermColSpec b)
-> Bool
-> InsPerm b
forall (b :: BackendType).
BoolExp b
-> Maybe (ColumnValues b Value)
-> Maybe (PermColSpec b)
-> Bool
-> InsPerm b
InsPerm
      (BoolExp b
 -> Maybe (HashMap (Column b) Value)
 -> Maybe (PermColSpec b)
 -> Bool
 -> InsPerm b)
-> Parser (BoolExp b)
-> Parser
     (Maybe (HashMap (Column b) Value)
      -> Maybe (PermColSpec b) -> Bool -> InsPerm b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (BoolExp b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"check"
      Parser
  (Maybe (HashMap (Column b) Value)
   -> Maybe (PermColSpec b) -> Bool -> InsPerm b)
-> Parser (Maybe (HashMap (Column b) Value))
-> Parser (Maybe (PermColSpec b) -> Bool -> InsPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (HashMap (Column b) Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"set"
      Parser (Maybe (PermColSpec b) -> Bool -> InsPerm b)
-> Parser (Maybe (PermColSpec b)) -> Parser (Bool -> InsPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (PermColSpec b))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"columns"
      Parser (Bool -> InsPerm b) -> Parser Bool -> Parser (InsPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backend_only" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

instance Backend b => ToJSON (InsPerm b) where
  toJSON :: InsPerm b -> Value
toJSON = Options -> InsPerm b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

type InsPermDef b = PermDef b InsPerm

data AllowedRootFields rootFieldType
  = ARFAllowAllRootFields
  | ARFAllowConfiguredRootFields (Set.HashSet rootFieldType)
  deriving (Int -> AllowedRootFields rootFieldType -> ShowS
[AllowedRootFields rootFieldType] -> ShowS
AllowedRootFields rootFieldType -> String
(Int -> AllowedRootFields rootFieldType -> ShowS)
-> (AllowedRootFields rootFieldType -> String)
-> ([AllowedRootFields rootFieldType] -> ShowS)
-> Show (AllowedRootFields rootFieldType)
forall rootFieldType.
Show rootFieldType =>
Int -> AllowedRootFields rootFieldType -> ShowS
forall rootFieldType.
Show rootFieldType =>
[AllowedRootFields rootFieldType] -> ShowS
forall rootFieldType.
Show rootFieldType =>
AllowedRootFields rootFieldType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllowedRootFields rootFieldType] -> ShowS
$cshowList :: forall rootFieldType.
Show rootFieldType =>
[AllowedRootFields rootFieldType] -> ShowS
show :: AllowedRootFields rootFieldType -> String
$cshow :: forall rootFieldType.
Show rootFieldType =>
AllowedRootFields rootFieldType -> String
showsPrec :: Int -> AllowedRootFields rootFieldType -> ShowS
$cshowsPrec :: forall rootFieldType.
Show rootFieldType =>
Int -> AllowedRootFields rootFieldType -> ShowS
Show, AllowedRootFields rootFieldType
-> AllowedRootFields rootFieldType -> Bool
(AllowedRootFields rootFieldType
 -> AllowedRootFields rootFieldType -> Bool)
-> (AllowedRootFields rootFieldType
    -> AllowedRootFields rootFieldType -> Bool)
-> Eq (AllowedRootFields rootFieldType)
forall rootFieldType.
Eq rootFieldType =>
AllowedRootFields rootFieldType
-> AllowedRootFields rootFieldType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllowedRootFields rootFieldType
-> AllowedRootFields rootFieldType -> Bool
$c/= :: forall rootFieldType.
Eq rootFieldType =>
AllowedRootFields rootFieldType
-> AllowedRootFields rootFieldType -> Bool
== :: AllowedRootFields rootFieldType
-> AllowedRootFields rootFieldType -> Bool
$c== :: forall rootFieldType.
Eq rootFieldType =>
AllowedRootFields rootFieldType
-> AllowedRootFields rootFieldType -> Bool
Eq, (forall x.
 AllowedRootFields rootFieldType
 -> Rep (AllowedRootFields rootFieldType) x)
-> (forall x.
    Rep (AllowedRootFields rootFieldType) x
    -> AllowedRootFields rootFieldType)
-> Generic (AllowedRootFields rootFieldType)
forall x.
Rep (AllowedRootFields rootFieldType) x
-> AllowedRootFields rootFieldType
forall x.
AllowedRootFields rootFieldType
-> Rep (AllowedRootFields rootFieldType) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall rootFieldType x.
Rep (AllowedRootFields rootFieldType) x
-> AllowedRootFields rootFieldType
forall rootFieldType x.
AllowedRootFields rootFieldType
-> Rep (AllowedRootFields rootFieldType) x
$cto :: forall rootFieldType x.
Rep (AllowedRootFields rootFieldType) x
-> AllowedRootFields rootFieldType
$cfrom :: forall rootFieldType x.
AllowedRootFields rootFieldType
-> Rep (AllowedRootFields rootFieldType) x
Generic)

instance (Cacheable rootFieldType) => Cacheable (AllowedRootFields rootFieldType)

instance (NFData rootFieldType) => NFData (AllowedRootFields rootFieldType)

instance (ToJSON rootFieldType) => ToJSON (AllowedRootFields rootFieldType) where
  toJSON :: AllowedRootFields rootFieldType -> Value
toJSON = \case
    AllowedRootFields rootFieldType
ARFAllowAllRootFields -> Text -> Value
String Text
"allow all root fields"
    ARFAllowConfiguredRootFields HashSet rootFieldType
configuredRootFields -> HashSet rootFieldType -> Value
forall a. ToJSON a => a -> Value
toJSON HashSet rootFieldType
configuredRootFields

instance Semigroup (HashSet rootFieldType) => Semigroup (AllowedRootFields rootFieldType) where
  AllowedRootFields rootFieldType
ARFAllowAllRootFields <> :: AllowedRootFields rootFieldType
-> AllowedRootFields rootFieldType
-> AllowedRootFields rootFieldType
<> AllowedRootFields rootFieldType
_ = AllowedRootFields rootFieldType
forall rootFieldType. AllowedRootFields rootFieldType
ARFAllowAllRootFields
  AllowedRootFields rootFieldType
_ <> AllowedRootFields rootFieldType
ARFAllowAllRootFields = AllowedRootFields rootFieldType
forall rootFieldType. AllowedRootFields rootFieldType
ARFAllowAllRootFields
  ARFAllowConfiguredRootFields HashSet rootFieldType
rfL <> ARFAllowConfiguredRootFields HashSet rootFieldType
rfR =
    HashSet rootFieldType -> AllowedRootFields rootFieldType
forall rootFieldType.
HashSet rootFieldType -> AllowedRootFields rootFieldType
ARFAllowConfiguredRootFields (HashSet rootFieldType
rfL HashSet rootFieldType
-> HashSet rootFieldType -> HashSet rootFieldType
forall a. Semigroup a => a -> a -> a
<> HashSet rootFieldType
rfR)

isRootFieldAllowed :: (Eq rootField) => rootField -> AllowedRootFields rootField -> Bool
isRootFieldAllowed :: rootField -> AllowedRootFields rootField -> Bool
isRootFieldAllowed rootField
rootField = \case
  AllowedRootFields rootField
ARFAllowAllRootFields -> Bool
True
  ARFAllowConfiguredRootFields HashSet rootField
allowedRootFields -> rootField
rootField rootField -> HashSet rootField -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` HashSet rootField
allowedRootFields

-- Select constraint
data SelPerm (b :: BackendType) = SelPerm
  { -- | Allowed columns
    SelPerm b -> PermColSpec b
spColumns :: PermColSpec b,
    -- | Filter expression
    SelPerm b -> BoolExp b
spFilter :: BoolExp b,
    -- | Limit value
    SelPerm b -> Maybe Int
spLimit :: Maybe Int,
    -- | Allow aggregation
    SelPerm b -> Bool
spAllowAggregations :: Bool,
    -- | Allowed computed fields which should not
    -- include the fields returning rows of existing table.
    SelPerm b -> [ComputedFieldName]
spComputedFields :: [ComputedFieldName],
    SelPerm b -> AllowedRootFields QueryRootFieldType
spAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType,
    SelPerm b -> AllowedRootFields SubscriptionRootFieldType
spAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
  }
  deriving (Int -> SelPerm b -> ShowS
[SelPerm b] -> ShowS
SelPerm b -> String
(Int -> SelPerm b -> ShowS)
-> (SelPerm b -> String)
-> ([SelPerm b] -> ShowS)
-> Show (SelPerm b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType). Backend b => Int -> SelPerm b -> ShowS
forall (b :: BackendType). Backend b => [SelPerm b] -> ShowS
forall (b :: BackendType). Backend b => SelPerm b -> String
showList :: [SelPerm b] -> ShowS
$cshowList :: forall (b :: BackendType). Backend b => [SelPerm b] -> ShowS
show :: SelPerm b -> String
$cshow :: forall (b :: BackendType). Backend b => SelPerm b -> String
showsPrec :: Int -> SelPerm b -> ShowS
$cshowsPrec :: forall (b :: BackendType). Backend b => Int -> SelPerm b -> ShowS
Show, SelPerm b -> SelPerm b -> Bool
(SelPerm b -> SelPerm b -> Bool)
-> (SelPerm b -> SelPerm b -> Bool) -> Eq (SelPerm b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
SelPerm b -> SelPerm b -> Bool
/= :: SelPerm b -> SelPerm b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
SelPerm b -> SelPerm b -> Bool
== :: SelPerm b -> SelPerm b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
SelPerm b -> SelPerm b -> Bool
Eq, (forall x. SelPerm b -> Rep (SelPerm b) x)
-> (forall x. Rep (SelPerm b) x -> SelPerm b)
-> Generic (SelPerm b)
forall x. Rep (SelPerm b) x -> SelPerm b
forall x. SelPerm b -> Rep (SelPerm b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (SelPerm b) x -> SelPerm b
forall (b :: BackendType) x. SelPerm b -> Rep (SelPerm b) x
$cto :: forall (b :: BackendType) x. Rep (SelPerm b) x -> SelPerm b
$cfrom :: forall (b :: BackendType) x. SelPerm b -> Rep (SelPerm b) x
Generic)

instance Backend b => Cacheable (SelPerm b)

instance Backend b => ToJSON (SelPerm b) where
  toJSON :: SelPerm b -> Value
toJSON SelPerm {Bool
[ComputedFieldName]
Maybe Int
BoolExp b
AllowedRootFields SubscriptionRootFieldType
AllowedRootFields QueryRootFieldType
PermColSpec b
spAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
spAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
spComputedFields :: [ComputedFieldName]
spAllowAggregations :: Bool
spLimit :: Maybe Int
spFilter :: BoolExp b
spColumns :: PermColSpec b
spAllowedSubscriptionRootFields :: forall (b :: BackendType).
SelPerm b -> AllowedRootFields SubscriptionRootFieldType
spAllowedQueryRootFields :: forall (b :: BackendType).
SelPerm b -> AllowedRootFields QueryRootFieldType
spComputedFields :: forall (b :: BackendType). SelPerm b -> [ComputedFieldName]
spAllowAggregations :: forall (b :: BackendType). SelPerm b -> Bool
spLimit :: forall (b :: BackendType). SelPerm b -> Maybe Int
spFilter :: forall (b :: BackendType). SelPerm b -> BoolExp b
spColumns :: forall (b :: BackendType). SelPerm b -> PermColSpec b
..} =
    let queryRootFieldsPair :: [Pair]
queryRootFieldsPair =
          case AllowedRootFields QueryRootFieldType
spAllowedQueryRootFields of
            AllowedRootFields QueryRootFieldType
ARFAllowAllRootFields -> [Pair]
forall a. Monoid a => a
mempty
            ARFAllowConfiguredRootFields HashSet QueryRootFieldType
configuredRootFields ->
              [Key
"query_root_fields" Key -> HashSet QueryRootFieldType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HashSet QueryRootFieldType
configuredRootFields]
        subscriptionRootFieldsPair :: [Pair]
subscriptionRootFieldsPair =
          case AllowedRootFields SubscriptionRootFieldType
spAllowedSubscriptionRootFields of
            AllowedRootFields SubscriptionRootFieldType
ARFAllowAllRootFields -> [Pair]
forall a. Monoid a => a
mempty
            ARFAllowConfiguredRootFields HashSet SubscriptionRootFieldType
configuredRootFields ->
              [Key
"subscription_root_fields" Key -> HashSet SubscriptionRootFieldType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= HashSet SubscriptionRootFieldType
configuredRootFields]
        limitPair :: [Pair]
limitPair =
          case Maybe Int
spLimit of
            Maybe Int
Nothing -> [Pair]
forall a. Monoid a => a
mempty
            Just Int
limit -> [Key
"limit" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
limit]
     in [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
          [ Key
"columns" Key -> PermColSpec b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PermColSpec b
spColumns,
            Key
"filter" Key -> BoolExp b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BoolExp b
spFilter,
            Key
"allow_aggregations" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
spAllowAggregations,
            Key
"computed_fields" Key -> [ComputedFieldName] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ComputedFieldName]
spComputedFields
          ]
            [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
queryRootFieldsPair
            [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
subscriptionRootFieldsPair
            [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
limitPair

instance Backend b => FromJSON (SelPerm b) where
  parseJSON :: Value -> Parser (SelPerm b)
parseJSON = do
    String
-> (Object -> Parser (SelPerm b)) -> Value -> Parser (SelPerm b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SelPerm" ((Object -> Parser (SelPerm b)) -> Value -> Parser (SelPerm b))
-> (Object -> Parser (SelPerm b)) -> Value -> Parser (SelPerm b)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Maybe (HashSet QueryRootFieldType)
queryRootFieldsMaybe <- Object
o Object -> Key -> Parser (Maybe (HashSet QueryRootFieldType))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"query_root_fields"
      Maybe (HashSet SubscriptionRootFieldType)
subscriptionRootFieldsMaybe <- Object
o Object -> Key -> Parser (Maybe (HashSet SubscriptionRootFieldType))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subscription_root_fields"
      AllowedRootFields QueryRootFieldType
allowedQueryRootFields <-
        case Maybe (HashSet QueryRootFieldType)
queryRootFieldsMaybe of
          Just HashSet QueryRootFieldType
configuredQueryRootFields -> do
            AllowedRootFields QueryRootFieldType
-> Parser (AllowedRootFields QueryRootFieldType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AllowedRootFields QueryRootFieldType
 -> Parser (AllowedRootFields QueryRootFieldType))
-> AllowedRootFields QueryRootFieldType
-> Parser (AllowedRootFields QueryRootFieldType)
forall a b. (a -> b) -> a -> b
$ HashSet QueryRootFieldType -> AllowedRootFields QueryRootFieldType
forall rootFieldType.
HashSet rootFieldType -> AllowedRootFields rootFieldType
ARFAllowConfiguredRootFields HashSet QueryRootFieldType
configuredQueryRootFields
          Maybe (HashSet QueryRootFieldType)
Nothing -> AllowedRootFields QueryRootFieldType
-> Parser (AllowedRootFields QueryRootFieldType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AllowedRootFields QueryRootFieldType
forall rootFieldType. AllowedRootFields rootFieldType
ARFAllowAllRootFields
      AllowedRootFields SubscriptionRootFieldType
allowedSubscriptionRootFields <-
        case Maybe (HashSet SubscriptionRootFieldType)
subscriptionRootFieldsMaybe of
          Just HashSet SubscriptionRootFieldType
configuredSubscriptionRootFields -> AllowedRootFields SubscriptionRootFieldType
-> Parser (AllowedRootFields SubscriptionRootFieldType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AllowedRootFields SubscriptionRootFieldType
 -> Parser (AllowedRootFields SubscriptionRootFieldType))
-> AllowedRootFields SubscriptionRootFieldType
-> Parser (AllowedRootFields SubscriptionRootFieldType)
forall a b. (a -> b) -> a -> b
$ HashSet SubscriptionRootFieldType
-> AllowedRootFields SubscriptionRootFieldType
forall rootFieldType.
HashSet rootFieldType -> AllowedRootFields rootFieldType
ARFAllowConfiguredRootFields HashSet SubscriptionRootFieldType
configuredSubscriptionRootFields
          Maybe (HashSet SubscriptionRootFieldType)
Nothing -> AllowedRootFields SubscriptionRootFieldType
-> Parser (AllowedRootFields SubscriptionRootFieldType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AllowedRootFields SubscriptionRootFieldType
 -> Parser (AllowedRootFields SubscriptionRootFieldType))
-> AllowedRootFields SubscriptionRootFieldType
-> Parser (AllowedRootFields SubscriptionRootFieldType)
forall a b. (a -> b) -> a -> b
$ AllowedRootFields SubscriptionRootFieldType
forall rootFieldType. AllowedRootFields rootFieldType
ARFAllowAllRootFields

      PermColSpec b
-> BoolExp b
-> Maybe Int
-> Bool
-> [ComputedFieldName]
-> AllowedRootFields QueryRootFieldType
-> AllowedRootFields SubscriptionRootFieldType
-> SelPerm b
forall (b :: BackendType).
PermColSpec b
-> BoolExp b
-> Maybe Int
-> Bool
-> [ComputedFieldName]
-> AllowedRootFields QueryRootFieldType
-> AllowedRootFields SubscriptionRootFieldType
-> SelPerm b
SelPerm
        (PermColSpec b
 -> BoolExp b
 -> Maybe Int
 -> Bool
 -> [ComputedFieldName]
 -> AllowedRootFields QueryRootFieldType
 -> AllowedRootFields SubscriptionRootFieldType
 -> SelPerm b)
-> Parser (PermColSpec b)
-> Parser
     (BoolExp b
      -> Maybe Int
      -> Bool
      -> [ComputedFieldName]
      -> AllowedRootFields QueryRootFieldType
      -> AllowedRootFields SubscriptionRootFieldType
      -> SelPerm b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (PermColSpec b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columns"
        Parser
  (BoolExp b
   -> Maybe Int
   -> Bool
   -> [ComputedFieldName]
   -> AllowedRootFields QueryRootFieldType
   -> AllowedRootFields SubscriptionRootFieldType
   -> SelPerm b)
-> Parser (BoolExp b)
-> Parser
     (Maybe Int
      -> Bool
      -> [ComputedFieldName]
      -> AllowedRootFields QueryRootFieldType
      -> AllowedRootFields SubscriptionRootFieldType
      -> SelPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (BoolExp b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"filter"
        Parser
  (Maybe Int
   -> Bool
   -> [ComputedFieldName]
   -> AllowedRootFields QueryRootFieldType
   -> AllowedRootFields SubscriptionRootFieldType
   -> SelPerm b)
-> Parser (Maybe Int)
-> Parser
     (Bool
      -> [ComputedFieldName]
      -> AllowedRootFields QueryRootFieldType
      -> AllowedRootFields SubscriptionRootFieldType
      -> SelPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"limit"
        Parser
  (Bool
   -> [ComputedFieldName]
   -> AllowedRootFields QueryRootFieldType
   -> AllowedRootFields SubscriptionRootFieldType
   -> SelPerm b)
-> Parser Bool
-> Parser
     ([ComputedFieldName]
      -> AllowedRootFields QueryRootFieldType
      -> AllowedRootFields SubscriptionRootFieldType
      -> SelPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_aggregations" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
        Parser
  ([ComputedFieldName]
   -> AllowedRootFields QueryRootFieldType
   -> AllowedRootFields SubscriptionRootFieldType
   -> SelPerm b)
-> Parser [ComputedFieldName]
-> Parser
     (AllowedRootFields QueryRootFieldType
      -> AllowedRootFields SubscriptionRootFieldType -> SelPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [ComputedFieldName])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"computed_fields" Parser (Maybe [ComputedFieldName])
-> [ComputedFieldName] -> Parser [ComputedFieldName]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
        Parser
  (AllowedRootFields QueryRootFieldType
   -> AllowedRootFields SubscriptionRootFieldType -> SelPerm b)
-> Parser (AllowedRootFields QueryRootFieldType)
-> Parser
     (AllowedRootFields SubscriptionRootFieldType -> SelPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AllowedRootFields QueryRootFieldType
-> Parser (AllowedRootFields QueryRootFieldType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AllowedRootFields QueryRootFieldType
allowedQueryRootFields
        Parser (AllowedRootFields SubscriptionRootFieldType -> SelPerm b)
-> Parser (AllowedRootFields SubscriptionRootFieldType)
-> Parser (SelPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AllowedRootFields SubscriptionRootFieldType
-> Parser (AllowedRootFields SubscriptionRootFieldType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AllowedRootFields SubscriptionRootFieldType
allowedSubscriptionRootFields

type SelPermDef b = PermDef b SelPerm

-- Delete permission
data DelPerm (b :: BackendType) = DelPerm
  { DelPerm b -> BoolExp b
dcFilter :: BoolExp b,
    DelPerm b -> Bool
dcBackendOnly :: Bool -- see Note [Backend only permissions]
  }
  deriving (Int -> DelPerm b -> ShowS
[DelPerm b] -> ShowS
DelPerm b -> String
(Int -> DelPerm b -> ShowS)
-> (DelPerm b -> String)
-> ([DelPerm b] -> ShowS)
-> Show (DelPerm b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType). Backend b => Int -> DelPerm b -> ShowS
forall (b :: BackendType). Backend b => [DelPerm b] -> ShowS
forall (b :: BackendType). Backend b => DelPerm b -> String
showList :: [DelPerm b] -> ShowS
$cshowList :: forall (b :: BackendType). Backend b => [DelPerm b] -> ShowS
show :: DelPerm b -> String
$cshow :: forall (b :: BackendType). Backend b => DelPerm b -> String
showsPrec :: Int -> DelPerm b -> ShowS
$cshowsPrec :: forall (b :: BackendType). Backend b => Int -> DelPerm b -> ShowS
Show, DelPerm b -> DelPerm b -> Bool
(DelPerm b -> DelPerm b -> Bool)
-> (DelPerm b -> DelPerm b -> Bool) -> Eq (DelPerm b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
DelPerm b -> DelPerm b -> Bool
/= :: DelPerm b -> DelPerm b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
DelPerm b -> DelPerm b -> Bool
== :: DelPerm b -> DelPerm b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
DelPerm b -> DelPerm b -> Bool
Eq, (forall x. DelPerm b -> Rep (DelPerm b) x)
-> (forall x. Rep (DelPerm b) x -> DelPerm b)
-> Generic (DelPerm b)
forall x. Rep (DelPerm b) x -> DelPerm b
forall x. DelPerm b -> Rep (DelPerm b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (DelPerm b) x -> DelPerm b
forall (b :: BackendType) x. DelPerm b -> Rep (DelPerm b) x
$cto :: forall (b :: BackendType) x. Rep (DelPerm b) x -> DelPerm b
$cfrom :: forall (b :: BackendType) x. DelPerm b -> Rep (DelPerm b) x
Generic)

instance Backend b => Cacheable (DelPerm b)

instance Backend b => FromJSON (DelPerm b) where
  parseJSON :: Value -> Parser (DelPerm b)
parseJSON = String
-> (Object -> Parser (DelPerm b)) -> Value -> Parser (DelPerm b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DelPerm" ((Object -> Parser (DelPerm b)) -> Value -> Parser (DelPerm b))
-> (Object -> Parser (DelPerm b)) -> Value -> Parser (DelPerm b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    BoolExp b -> Bool -> DelPerm b
forall (b :: BackendType). BoolExp b -> Bool -> DelPerm b
DelPerm
      (BoolExp b -> Bool -> DelPerm b)
-> Parser (BoolExp b) -> Parser (Bool -> DelPerm b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (BoolExp b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"filter"
      Parser (Bool -> DelPerm b) -> Parser Bool -> Parser (DelPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backend_only" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

instance Backend b => ToJSON (DelPerm b) where
  toJSON :: DelPerm b -> Value
toJSON = Options -> DelPerm b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

type DelPermDef b = PermDef b DelPerm

-- Update constraint
data UpdPerm (b :: BackendType) = UpdPerm
  { UpdPerm b -> PermColSpec b
ucColumns :: PermColSpec b, -- Allowed columns
    UpdPerm b -> Maybe (ColumnValues b Value)
ucSet :: Maybe (ColumnValues b Value), -- Preset columns
    UpdPerm b -> BoolExp b
ucFilter :: BoolExp b, -- Filter expression (applied before update)

    -- | Check expression, which must be true after update.
    -- This is optional because we don't want to break the v1 API
    -- but Nothing should be equivalent to the expression which always
    -- returns true.
    UpdPerm b -> Maybe (BoolExp b)
ucCheck :: Maybe (BoolExp b),
    UpdPerm b -> Bool
ucBackendOnly :: Bool -- see Note [Backend only permissions]
  }
  deriving (Int -> UpdPerm b -> ShowS
[UpdPerm b] -> ShowS
UpdPerm b -> String
(Int -> UpdPerm b -> ShowS)
-> (UpdPerm b -> String)
-> ([UpdPerm b] -> ShowS)
-> Show (UpdPerm b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType). Backend b => Int -> UpdPerm b -> ShowS
forall (b :: BackendType). Backend b => [UpdPerm b] -> ShowS
forall (b :: BackendType). Backend b => UpdPerm b -> String
showList :: [UpdPerm b] -> ShowS
$cshowList :: forall (b :: BackendType). Backend b => [UpdPerm b] -> ShowS
show :: UpdPerm b -> String
$cshow :: forall (b :: BackendType). Backend b => UpdPerm b -> String
showsPrec :: Int -> UpdPerm b -> ShowS
$cshowsPrec :: forall (b :: BackendType). Backend b => Int -> UpdPerm b -> ShowS
Show, UpdPerm b -> UpdPerm b -> Bool
(UpdPerm b -> UpdPerm b -> Bool)
-> (UpdPerm b -> UpdPerm b -> Bool) -> Eq (UpdPerm b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
UpdPerm b -> UpdPerm b -> Bool
/= :: UpdPerm b -> UpdPerm b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
UpdPerm b -> UpdPerm b -> Bool
== :: UpdPerm b -> UpdPerm b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
UpdPerm b -> UpdPerm b -> Bool
Eq, (forall x. UpdPerm b -> Rep (UpdPerm b) x)
-> (forall x. Rep (UpdPerm b) x -> UpdPerm b)
-> Generic (UpdPerm b)
forall x. Rep (UpdPerm b) x -> UpdPerm b
forall x. UpdPerm b -> Rep (UpdPerm b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (UpdPerm b) x -> UpdPerm b
forall (b :: BackendType) x. UpdPerm b -> Rep (UpdPerm b) x
$cto :: forall (b :: BackendType) x. Rep (UpdPerm b) x -> UpdPerm b
$cfrom :: forall (b :: BackendType) x. UpdPerm b -> Rep (UpdPerm b) x
Generic)

instance Backend b => Cacheable (UpdPerm b)

instance Backend b => FromJSON (UpdPerm b) where
  parseJSON :: Value -> Parser (UpdPerm b)
parseJSON = String
-> (Object -> Parser (UpdPerm b)) -> Value -> Parser (UpdPerm b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UpdPerm" ((Object -> Parser (UpdPerm b)) -> Value -> Parser (UpdPerm b))
-> (Object -> Parser (UpdPerm b)) -> Value -> Parser (UpdPerm b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    PermColSpec b
-> Maybe (HashMap (Column b) Value)
-> BoolExp b
-> Maybe (BoolExp b)
-> Bool
-> UpdPerm b
forall (b :: BackendType).
PermColSpec b
-> Maybe (ColumnValues b Value)
-> BoolExp b
-> Maybe (BoolExp b)
-> Bool
-> UpdPerm b
UpdPerm
      (PermColSpec b
 -> Maybe (HashMap (Column b) Value)
 -> BoolExp b
 -> Maybe (BoolExp b)
 -> Bool
 -> UpdPerm b)
-> Parser (PermColSpec b)
-> Parser
     (Maybe (HashMap (Column b) Value)
      -> BoolExp b -> Maybe (BoolExp b) -> Bool -> UpdPerm b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (PermColSpec b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columns"
      Parser
  (Maybe (HashMap (Column b) Value)
   -> BoolExp b -> Maybe (BoolExp b) -> Bool -> UpdPerm b)
-> Parser (Maybe (HashMap (Column b) Value))
-> Parser (BoolExp b -> Maybe (BoolExp b) -> Bool -> UpdPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (HashMap (Column b) Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"set"
      Parser (BoolExp b -> Maybe (BoolExp b) -> Bool -> UpdPerm b)
-> Parser (BoolExp b)
-> Parser (Maybe (BoolExp b) -> Bool -> UpdPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (BoolExp b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"filter"
      Parser (Maybe (BoolExp b) -> Bool -> UpdPerm b)
-> Parser (Maybe (BoolExp b)) -> Parser (Bool -> UpdPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (BoolExp b))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"check"
      Parser (Bool -> UpdPerm b) -> Parser Bool -> Parser (UpdPerm b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backend_only" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

instance Backend b => ToJSON (UpdPerm b) where
  toJSON :: UpdPerm b -> Value
toJSON = Options -> UpdPerm b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

type UpdPermDef b = PermDef b UpdPerm

-- The Expression-level TemplateHaskell splices below fail unless there is a
-- declaration-level splice before to ensure phase separation.
-- See https://gitlab.haskell.org/ghc/ghc/-/issues/9813
$(return [])

instance Backend b => FromJSON (PermDef b SelPerm) where
  parseJSON :: Value -> Parser (PermDef b SelPerm)
parseJSON = $(mkParseJSON hasuraJSON ''PermDef)

instance Backend b => FromJSON (PermDef b InsPerm) where
  parseJSON :: Value -> Parser (PermDef b InsPerm)
parseJSON = $(mkParseJSON hasuraJSON ''PermDef)

instance Backend b => FromJSON (PermDef b UpdPerm) where
  parseJSON :: Value -> Parser (PermDef b UpdPerm)
parseJSON = $(mkParseJSON hasuraJSON ''PermDef)

instance Backend b => FromJSON (PermDef b DelPerm) where
  parseJSON :: Value -> Parser (PermDef b DelPerm)
parseJSON = $(mkParseJSON hasuraJSON ''PermDef)

$(makeLenses ''PermDef)