module Hasura.RQL.Types.Roles
  ( DropInheritedRole (..),
    InheritedRole,
    ParentRoles (..),
    Role (..),
    RoleName,
    mkRoleName,
    mkRoleNameSafe,
    adminRoleName,
    roleNameToTxt,
  )
where

import Autodocodec (HasCodec (codec), dimapCodec, requiredField')
import Autodocodec qualified as AC
import Autodocodec.Extended (hashSetCodec)
import Data.Aeson
import Data.Aeson.Casing
import Data.Text.Extended (ToTxt (toTxt))
import Data.Text.NonEmpty (NonEmptyText, mkNonEmptyText, mkNonEmptyTextUnsafe, nonEmptyTextCodec, unNonEmptyText)
import Database.PG.Query qualified as PG
import Hasura.Prelude

newtype RoleName = RoleName {RoleName -> NonEmptyText
getRoleTxt :: NonEmptyText}
  deriving
    ( Int -> RoleName -> ShowS
[RoleName] -> ShowS
RoleName -> String
(Int -> RoleName -> ShowS)
-> (RoleName -> String) -> ([RoleName] -> ShowS) -> Show RoleName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RoleName -> ShowS
showsPrec :: Int -> RoleName -> ShowS
$cshow :: RoleName -> String
show :: RoleName -> String
$cshowList :: [RoleName] -> ShowS
showList :: [RoleName] -> ShowS
Show,
      RoleName -> RoleName -> Bool
(RoleName -> RoleName -> Bool)
-> (RoleName -> RoleName -> Bool) -> Eq RoleName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RoleName -> RoleName -> Bool
== :: RoleName -> RoleName -> Bool
$c/= :: RoleName -> RoleName -> Bool
/= :: RoleName -> RoleName -> Bool
Eq,
      Eq RoleName
Eq RoleName
-> (RoleName -> RoleName -> Ordering)
-> (RoleName -> RoleName -> Bool)
-> (RoleName -> RoleName -> Bool)
-> (RoleName -> RoleName -> Bool)
-> (RoleName -> RoleName -> Bool)
-> (RoleName -> RoleName -> RoleName)
-> (RoleName -> RoleName -> RoleName)
-> Ord RoleName
RoleName -> RoleName -> Bool
RoleName -> RoleName -> Ordering
RoleName -> RoleName -> RoleName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RoleName -> RoleName -> Ordering
compare :: RoleName -> RoleName -> Ordering
$c< :: RoleName -> RoleName -> Bool
< :: RoleName -> RoleName -> Bool
$c<= :: RoleName -> RoleName -> Bool
<= :: RoleName -> RoleName -> Bool
$c> :: RoleName -> RoleName -> Bool
> :: RoleName -> RoleName -> Bool
$c>= :: RoleName -> RoleName -> Bool
>= :: RoleName -> RoleName -> Bool
$cmax :: RoleName -> RoleName -> RoleName
max :: RoleName -> RoleName -> RoleName
$cmin :: RoleName -> RoleName -> RoleName
min :: RoleName -> RoleName -> RoleName
Ord,
      Eq RoleName
Eq RoleName
-> (Int -> RoleName -> Int)
-> (RoleName -> Int)
-> Hashable RoleName
Int -> RoleName -> Int
RoleName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> RoleName -> Int
hashWithSalt :: Int -> RoleName -> Int
$chash :: RoleName -> Int
hash :: RoleName -> Int
Hashable,
      FromJSONKeyFunction [RoleName]
FromJSONKeyFunction RoleName
FromJSONKeyFunction RoleName
-> FromJSONKeyFunction [RoleName] -> FromJSONKey RoleName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction RoleName
fromJSONKey :: FromJSONKeyFunction RoleName
$cfromJSONKeyList :: FromJSONKeyFunction [RoleName]
fromJSONKeyList :: FromJSONKeyFunction [RoleName]
FromJSONKey,
      ToJSONKeyFunction [RoleName]
ToJSONKeyFunction RoleName
ToJSONKeyFunction RoleName
-> ToJSONKeyFunction [RoleName] -> ToJSONKey RoleName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction RoleName
toJSONKey :: ToJSONKeyFunction RoleName
$ctoJSONKeyList :: ToJSONKeyFunction [RoleName]
toJSONKeyList :: ToJSONKeyFunction [RoleName]
ToJSONKey,
      Value -> Parser [RoleName]
Value -> Parser RoleName
(Value -> Parser RoleName)
-> (Value -> Parser [RoleName]) -> FromJSON RoleName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RoleName
parseJSON :: Value -> Parser RoleName
$cparseJSONList :: Value -> Parser [RoleName]
parseJSONList :: Value -> Parser [RoleName]
FromJSON,
      [RoleName] -> Value
[RoleName] -> Encoding
RoleName -> Value
RoleName -> Encoding
(RoleName -> Value)
-> (RoleName -> Encoding)
-> ([RoleName] -> Value)
-> ([RoleName] -> Encoding)
-> ToJSON RoleName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RoleName -> Value
toJSON :: RoleName -> Value
$ctoEncoding :: RoleName -> Encoding
toEncoding :: RoleName -> Encoding
$ctoJSONList :: [RoleName] -> Value
toJSONList :: [RoleName] -> Value
$ctoEncodingList :: [RoleName] -> Encoding
toEncodingList :: [RoleName] -> Encoding
ToJSON,
      Maybe ByteString -> Either Text RoleName
(Maybe ByteString -> Either Text RoleName) -> FromCol RoleName
forall a. (Maybe ByteString -> Either Text a) -> FromCol a
$cfromCol :: Maybe ByteString -> Either Text RoleName
fromCol :: Maybe ByteString -> Either Text RoleName
PG.FromCol,
      RoleName -> PrepArg
(RoleName -> PrepArg) -> ToPrepArg RoleName
forall a. (a -> PrepArg) -> ToPrepArg a
$ctoPrepVal :: RoleName -> PrepArg
toPrepVal :: RoleName -> PrepArg
PG.ToPrepArg,
      (forall x. RoleName -> Rep RoleName x)
-> (forall x. Rep RoleName x -> RoleName) -> Generic RoleName
forall x. Rep RoleName x -> RoleName
forall x. RoleName -> Rep RoleName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RoleName -> Rep RoleName x
from :: forall x. RoleName -> Rep RoleName x
$cto :: forall x. Rep RoleName x -> RoleName
to :: forall x. Rep RoleName x -> RoleName
Generic,
      RoleName -> ()
(RoleName -> ()) -> NFData RoleName
forall a. (a -> ()) -> NFData a
$crnf :: RoleName -> ()
rnf :: RoleName -> ()
NFData
    )

instance HasCodec RoleName where
  codec :: JSONCodec RoleName
codec = (NonEmptyText -> RoleName)
-> (RoleName -> NonEmptyText)
-> Codec Value NonEmptyText NonEmptyText
-> JSONCodec RoleName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec NonEmptyText -> RoleName
RoleName RoleName -> NonEmptyText
getRoleTxt Codec Value NonEmptyText NonEmptyText
nonEmptyTextCodec

roleNameToTxt :: RoleName -> Text
roleNameToTxt :: RoleName -> Text
roleNameToTxt = NonEmptyText -> Text
unNonEmptyText (NonEmptyText -> Text)
-> (RoleName -> NonEmptyText) -> RoleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoleName -> NonEmptyText
getRoleTxt

instance ToTxt RoleName where
  toTxt :: RoleName -> Text
toTxt = RoleName -> Text
roleNameToTxt

mkRoleName :: Text -> Maybe RoleName
mkRoleName :: Text -> Maybe RoleName
mkRoleName = (NonEmptyText -> RoleName) -> Maybe NonEmptyText -> Maybe RoleName
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmptyText -> RoleName
RoleName (Maybe NonEmptyText -> Maybe RoleName)
-> (Text -> Maybe NonEmptyText) -> Text -> Maybe RoleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe NonEmptyText
mkNonEmptyText

mkRoleNameSafe :: NonEmptyText -> RoleName
mkRoleNameSafe :: NonEmptyText -> RoleName
mkRoleNameSafe = NonEmptyText -> RoleName
RoleName

adminRoleName :: RoleName
adminRoleName :: RoleName
adminRoleName = NonEmptyText -> RoleName
RoleName (NonEmptyText -> RoleName) -> NonEmptyText -> RoleName
forall a b. (a -> b) -> a -> b
$ Text -> NonEmptyText
mkNonEmptyTextUnsafe Text
"admin"

newtype ParentRoles = ParentRoles {ParentRoles -> HashSet RoleName
_unParentRoles :: HashSet RoleName}
  deriving (Int -> ParentRoles -> ShowS
[ParentRoles] -> ShowS
ParentRoles -> String
(Int -> ParentRoles -> ShowS)
-> (ParentRoles -> String)
-> ([ParentRoles] -> ShowS)
-> Show ParentRoles
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParentRoles -> ShowS
showsPrec :: Int -> ParentRoles -> ShowS
$cshow :: ParentRoles -> String
show :: ParentRoles -> String
$cshowList :: [ParentRoles] -> ShowS
showList :: [ParentRoles] -> ShowS
Show, ParentRoles -> ParentRoles -> Bool
(ParentRoles -> ParentRoles -> Bool)
-> (ParentRoles -> ParentRoles -> Bool) -> Eq ParentRoles
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParentRoles -> ParentRoles -> Bool
== :: ParentRoles -> ParentRoles -> Bool
$c/= :: ParentRoles -> ParentRoles -> Bool
/= :: ParentRoles -> ParentRoles -> Bool
Eq, [ParentRoles] -> Value
[ParentRoles] -> Encoding
ParentRoles -> Value
ParentRoles -> Encoding
(ParentRoles -> Value)
-> (ParentRoles -> Encoding)
-> ([ParentRoles] -> Value)
-> ([ParentRoles] -> Encoding)
-> ToJSON ParentRoles
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ParentRoles -> Value
toJSON :: ParentRoles -> Value
$ctoEncoding :: ParentRoles -> Encoding
toEncoding :: ParentRoles -> Encoding
$ctoJSONList :: [ParentRoles] -> Value
toJSONList :: [ParentRoles] -> Value
$ctoEncodingList :: [ParentRoles] -> Encoding
toEncodingList :: [ParentRoles] -> Encoding
ToJSON, Value -> Parser [ParentRoles]
Value -> Parser ParentRoles
(Value -> Parser ParentRoles)
-> (Value -> Parser [ParentRoles]) -> FromJSON ParentRoles
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ParentRoles
parseJSON :: Value -> Parser ParentRoles
$cparseJSONList :: Value -> Parser [ParentRoles]
parseJSONList :: Value -> Parser [ParentRoles]
FromJSON, (forall x. ParentRoles -> Rep ParentRoles x)
-> (forall x. Rep ParentRoles x -> ParentRoles)
-> Generic ParentRoles
forall x. Rep ParentRoles x -> ParentRoles
forall x. ParentRoles -> Rep ParentRoles x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParentRoles -> Rep ParentRoles x
from :: forall x. ParentRoles -> Rep ParentRoles x
$cto :: forall x. Rep ParentRoles x -> ParentRoles
to :: forall x. Rep ParentRoles x -> ParentRoles
Generic)

instance Hashable ParentRoles

instance HasCodec ParentRoles where
  codec :: JSONCodec ParentRoles
codec = (HashSet RoleName -> ParentRoles)
-> (ParentRoles -> HashSet RoleName)
-> Codec Value (HashSet RoleName) (HashSet RoleName)
-> JSONCodec ParentRoles
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec HashSet RoleName -> ParentRoles
ParentRoles ParentRoles -> HashSet RoleName
_unParentRoles Codec Value (HashSet RoleName) (HashSet RoleName)
forall a. (Hashable a, HasCodec a) => JSONCodec (HashSet a)
hashSetCodec

-- | The `Role` type represents a role by
--   containing its name and the names of its parent roles.
--   This type is used externally in the `add_inherited_role`
--   metadata API and is also used internally
--   in the permission building
--   part of the schema cache building process
data Role = Role
  { Role -> RoleName
_rRoleName :: RoleName,
    -- | set of the parent role names, in case of
    -- non-inherited roles it will be an empty set
    Role -> ParentRoles
_rParentRoles :: ParentRoles
  }
  deriving (Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Role -> ShowS
showsPrec :: Int -> Role -> ShowS
$cshow :: Role -> String
show :: Role -> String
$cshowList :: [Role] -> ShowS
showList :: [Role] -> ShowS
Show, Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
/= :: Role -> Role -> Bool
Eq, (forall x. Role -> Rep Role x)
-> (forall x. Rep Role x -> Role) -> Generic Role
forall x. Rep Role x -> Role
forall x. Role -> Rep Role x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Role -> Rep Role x
from :: forall x. Role -> Rep Role x
$cto :: forall x. Rep Role x -> Role
to :: forall x. Rep Role x -> Role
Generic)

instance Hashable Role

instance HasCodec Role where
  codec :: JSONCodec Role
codec =
    Text -> ObjectCodec Role Role -> JSONCodec Role
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"Role"
      (ObjectCodec Role Role -> JSONCodec Role)
-> ObjectCodec Role Role -> JSONCodec Role
forall a b. (a -> b) -> a -> b
$ RoleName -> ParentRoles -> Role
Role
      (RoleName -> ParentRoles -> Role)
-> Codec Object Role RoleName
-> Codec Object Role (ParentRoles -> Role)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec RoleName RoleName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"role_name"
      ObjectCodec RoleName RoleName
-> (Role -> RoleName) -> Codec Object Role RoleName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= Role -> RoleName
_rRoleName
        Codec Object Role (ParentRoles -> Role)
-> Codec Object Role ParentRoles -> ObjectCodec Role Role
forall a b.
Codec Object Role (a -> b)
-> Codec Object Role a -> Codec Object Role b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec ParentRoles ParentRoles
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"role_set"
      ObjectCodec ParentRoles ParentRoles
-> (Role -> ParentRoles) -> Codec Object Role ParentRoles
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= Role -> ParentRoles
_rParentRoles

instance ToJSON Role where
  toJSON :: Role -> Value
toJSON (Role RoleName
roleName ParentRoles
parentRoles) =
    [Pair] -> Value
object
      [ Key
"role_name" Key -> RoleName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= RoleName
roleName,
        -- the key for parent roles is "role_set"
        -- in the JSON encoding of the `Role` type
        -- is because when this feature
        -- was introduced, it was added as "role_set"
        Key
"role_set" Key -> ParentRoles -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ParentRoles
parentRoles
      ]

instance FromJSON Role where
  parseJSON :: Value -> Parser Role
parseJSON = String -> (Object -> Parser Role) -> Value -> Parser Role
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Role" ((Object -> Parser Role) -> Value -> Parser Role)
-> (Object -> Parser Role) -> Value -> Parser Role
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    RoleName -> ParentRoles -> Role
Role (RoleName -> ParentRoles -> Role)
-> Parser RoleName -> Parser (ParentRoles -> Role)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser RoleName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role_name" Parser (ParentRoles -> Role) -> Parser ParentRoles -> Parser Role
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ParentRoles
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role_set"

type InheritedRole = Role

newtype DropInheritedRole = DropInheritedRole
  { DropInheritedRole -> RoleName
_ddrRoleName :: RoleName
  }
  deriving stock (Int -> DropInheritedRole -> ShowS
[DropInheritedRole] -> ShowS
DropInheritedRole -> String
(Int -> DropInheritedRole -> ShowS)
-> (DropInheritedRole -> String)
-> ([DropInheritedRole] -> ShowS)
-> Show DropInheritedRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DropInheritedRole -> ShowS
showsPrec :: Int -> DropInheritedRole -> ShowS
$cshow :: DropInheritedRole -> String
show :: DropInheritedRole -> String
$cshowList :: [DropInheritedRole] -> ShowS
showList :: [DropInheritedRole] -> ShowS
Show, DropInheritedRole -> DropInheritedRole -> Bool
(DropInheritedRole -> DropInheritedRole -> Bool)
-> (DropInheritedRole -> DropInheritedRole -> Bool)
-> Eq DropInheritedRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DropInheritedRole -> DropInheritedRole -> Bool
== :: DropInheritedRole -> DropInheritedRole -> Bool
$c/= :: DropInheritedRole -> DropInheritedRole -> Bool
/= :: DropInheritedRole -> DropInheritedRole -> Bool
Eq, (forall x. DropInheritedRole -> Rep DropInheritedRole x)
-> (forall x. Rep DropInheritedRole x -> DropInheritedRole)
-> Generic DropInheritedRole
forall x. Rep DropInheritedRole x -> DropInheritedRole
forall x. DropInheritedRole -> Rep DropInheritedRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DropInheritedRole -> Rep DropInheritedRole x
from :: forall x. DropInheritedRole -> Rep DropInheritedRole x
$cto :: forall x. Rep DropInheritedRole x -> DropInheritedRole
to :: forall x. Rep DropInheritedRole x -> DropInheritedRole
Generic)

instance FromJSON DropInheritedRole where
  parseJSON :: Value -> Parser DropInheritedRole
parseJSON = Options -> Value -> Parser DropInheritedRole
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Int -> ShowS -> Options
aesonDrop Int
4 ShowS
snakeCase)

instance ToJSON DropInheritedRole where
  toJSON :: DropInheritedRole -> Value
toJSON = Options -> DropInheritedRole -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Int -> ShowS -> Options
aesonDrop Int
4 ShowS
snakeCase)
  toEncoding :: DropInheritedRole -> Encoding
toEncoding = Options -> DropInheritedRole -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Int -> ShowS -> Options
aesonDrop Int
4 ShowS
snakeCase)