module Hasura.RQL.Types.Allowlist
  ( -- | The schema cache representation of the allowlist
    InlinedAllowlist (..),
    inlineAllowlist,
    AllowlistMode (..),
    allowlistAllowsQuery,
    -- | The normalised metadata representation of the allowlist
    AllowlistEntry (..),
    UpdateScopeOfCollectionInAllowlist (..),
    MetadataAllowlist,
    DropCollectionFromAllowlist (..),
    AllowlistScope (..),
    metadataAllowlistInsert,
    metadataAllowlistUpdateScope,
    metadataAllowlistAllCollections,
    NormalizedQuery (..),
  )
where

import Autodocodec (HasCodec, bimapCodec, disjointEitherCodec, optionalFieldWithDefault', requiredField')
import Autodocodec qualified as AC
import Autodocodec.Extended (discriminatorBoolField)
import Data.Aeson
import Data.HashMap.Strict.Extended qualified as HashMap
import Data.HashMap.Strict.InsOrd.Extended qualified as InsOrdHashMap
import Data.HashSet qualified as S
import Data.Text.Extended ((<<>))
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.Prelude
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.Roles (RoleName)
import Language.GraphQL.Draft.Syntax qualified as G

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

instance FromJSON DropCollectionFromAllowlist where
  parseJSON :: Value -> Parser DropCollectionFromAllowlist
parseJSON = Options -> Value -> Parser DropCollectionFromAllowlist
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

instance ToJSON DropCollectionFromAllowlist where
  toJSON :: DropCollectionFromAllowlist -> Value
toJSON = Options -> DropCollectionFromAllowlist -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: DropCollectionFromAllowlist -> Encoding
toEncoding = Options -> DropCollectionFromAllowlist -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

data AllowlistScope
  = AllowlistScopeGlobal
  | AllowlistScopeRoles (NonEmpty RoleName)
  deriving (Int -> AllowlistScope -> ShowS
[AllowlistScope] -> ShowS
AllowlistScope -> String
(Int -> AllowlistScope -> ShowS)
-> (AllowlistScope -> String)
-> ([AllowlistScope] -> ShowS)
-> Show AllowlistScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AllowlistScope -> ShowS
showsPrec :: Int -> AllowlistScope -> ShowS
$cshow :: AllowlistScope -> String
show :: AllowlistScope -> String
$cshowList :: [AllowlistScope] -> ShowS
showList :: [AllowlistScope] -> ShowS
Show, AllowlistScope -> AllowlistScope -> Bool
(AllowlistScope -> AllowlistScope -> Bool)
-> (AllowlistScope -> AllowlistScope -> Bool) -> Eq AllowlistScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AllowlistScope -> AllowlistScope -> Bool
== :: AllowlistScope -> AllowlistScope -> Bool
$c/= :: AllowlistScope -> AllowlistScope -> Bool
/= :: AllowlistScope -> AllowlistScope -> Bool
Eq, (forall x. AllowlistScope -> Rep AllowlistScope x)
-> (forall x. Rep AllowlistScope x -> AllowlistScope)
-> Generic AllowlistScope
forall x. Rep AllowlistScope x -> AllowlistScope
forall x. AllowlistScope -> Rep AllowlistScope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AllowlistScope -> Rep AllowlistScope x
from :: forall x. AllowlistScope -> Rep AllowlistScope x
$cto :: forall x. Rep AllowlistScope x -> AllowlistScope
to :: forall x. Rep AllowlistScope x -> AllowlistScope
Generic)

instance HasCodec AllowlistScope where
  codec :: JSONCodec AllowlistScope
codec = (Either () (NonEmpty RoleName) -> Either String AllowlistScope)
-> (AllowlistScope -> Either () (NonEmpty RoleName))
-> Codec
     Value
     (Either () (NonEmpty RoleName))
     (Either () (NonEmpty RoleName))
-> JSONCodec AllowlistScope
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
bimapCodec Either () (NonEmpty RoleName) -> Either String AllowlistScope
forall {a} {a}.
IsString a =>
Either a (NonEmpty RoleName) -> Either a AllowlistScope
dec AllowlistScope -> Either () (NonEmpty RoleName)
enc (Codec
   Value
   (Either () (NonEmpty RoleName))
   (Either () (NonEmpty RoleName))
 -> JSONCodec AllowlistScope)
-> Codec
     Value
     (Either () (NonEmpty RoleName))
     (Either () (NonEmpty RoleName))
-> JSONCodec AllowlistScope
forall a b. (a -> b) -> a -> b
$ Codec Value () ()
-> Codec Value (NonEmpty RoleName) (NonEmpty RoleName)
-> Codec
     Value
     (Either () (NonEmpty RoleName))
     (Either () (NonEmpty RoleName))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec Codec Value () ()
forall {input}. ValueCodec input ()
global Codec Value (NonEmpty RoleName) (NonEmpty RoleName)
scopeRoles
    where
      global :: ValueCodec input ()
global = Text -> ObjectCodec input () -> ValueCodec input ()
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"AllowlistScopeGlobal" (ObjectCodec input () -> ValueCodec input ())
-> ObjectCodec input () -> ValueCodec input ()
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> ObjectCodec input ()
forall a. Text -> Bool -> ObjectCodec a ()
discriminatorBoolField Text
"global" Bool
True
      scopeRoles :: Codec Value (NonEmpty RoleName) (NonEmpty RoleName)
scopeRoles =
        Text
-> ObjectCodec (NonEmpty RoleName) (NonEmpty RoleName)
-> Codec Value (NonEmpty RoleName) (NonEmpty RoleName)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"AllowlistScopeRoles"
          (ObjectCodec (NonEmpty RoleName) (NonEmpty RoleName)
 -> Codec Value (NonEmpty RoleName) (NonEmpty RoleName))
-> ObjectCodec (NonEmpty RoleName) (NonEmpty RoleName)
-> Codec Value (NonEmpty RoleName) (NonEmpty RoleName)
forall a b. (a -> b) -> a -> b
$ Codec Object (NonEmpty RoleName) ()
-> Codec Object (NonEmpty RoleName) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Bool -> Codec Object (NonEmpty RoleName) ()
forall a. Text -> Bool -> ObjectCodec a ()
discriminatorBoolField Text
"global" Bool
False)
          Codec Object (NonEmpty RoleName) ()
-> ObjectCodec (NonEmpty RoleName) (NonEmpty RoleName)
-> ObjectCodec (NonEmpty RoleName) (NonEmpty RoleName)
forall a b.
Codec Object (NonEmpty RoleName) a
-> Codec Object (NonEmpty RoleName) b
-> Codec Object (NonEmpty RoleName) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> ObjectCodec (NonEmpty RoleName) (NonEmpty RoleName)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"roles"

      dec :: Either a (NonEmpty RoleName) -> Either a AllowlistScope
dec (Left a
_) = AllowlistScope -> Either a AllowlistScope
forall a b. b -> Either a b
Right AllowlistScope
AllowlistScopeGlobal
      dec (Right NonEmpty RoleName
roles)
        | NonEmpty RoleName -> Bool
forall {t :: * -> *} {a}. (Foldable t, Hashable a) => t a -> Bool
hasDups NonEmpty RoleName
roles = a -> Either a AllowlistScope
forall a b. a -> Either a b
Left a
"duplicate roles are not allowed"
        | Bool
otherwise = AllowlistScope -> Either a AllowlistScope
forall a b. b -> Either a b
Right (AllowlistScope -> Either a AllowlistScope)
-> AllowlistScope -> Either a AllowlistScope
forall a b. (a -> b) -> a -> b
$ NonEmpty RoleName -> AllowlistScope
AllowlistScopeRoles NonEmpty RoleName
roles
      enc :: AllowlistScope -> Either () (NonEmpty RoleName)
enc AllowlistScope
AllowlistScopeGlobal = () -> Either () (NonEmpty RoleName)
forall a b. a -> Either a b
Left ()
      enc (AllowlistScopeRoles NonEmpty RoleName
roles) = NonEmpty RoleName -> Either () (NonEmpty RoleName)
forall a b. b -> Either a b
Right NonEmpty RoleName
roles

      hasDups :: t a -> Bool
hasDups t a
xs = t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= HashSet a -> Int
forall a. HashSet a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList (t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
xs))

instance FromJSON AllowlistScope where
  parseJSON :: Value -> Parser AllowlistScope
parseJSON = String
-> (Object -> Parser AllowlistScope)
-> Value
-> Parser AllowlistScope
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AllowlistScope" ((Object -> Parser AllowlistScope)
 -> Value -> Parser AllowlistScope)
-> (Object -> Parser AllowlistScope)
-> Value
-> Parser AllowlistScope
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Bool
global <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"global"
    if Bool
global
      then do
        Maybe (NonEmpty RoleName)
roles :: Maybe (NonEmpty RoleName) <- Object
o Object -> Key -> Parser (Maybe (NonEmpty RoleName))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"roles"
        case Maybe (NonEmpty RoleName)
roles of
          Maybe (NonEmpty RoleName)
Nothing -> AllowlistScope -> Parser AllowlistScope
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AllowlistScope
AllowlistScopeGlobal
          Just {} -> String -> Parser AllowlistScope
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"roles are not allowed when global is true"
      else do
        NonEmpty RoleName
roles <- Object
o Object -> Key -> Parser (NonEmpty RoleName)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"roles"
        if (NonEmpty RoleName -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty RoleName
roles Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= HashSet RoleName -> Int
forall a. HashSet a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([RoleName] -> HashSet RoleName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList (NonEmpty RoleName -> [RoleName]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty RoleName
roles)))
          then String -> Parser AllowlistScope
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"duplicate roles are not allowed"
          else AllowlistScope -> Parser AllowlistScope
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AllowlistScope -> Parser AllowlistScope)
-> AllowlistScope -> Parser AllowlistScope
forall a b. (a -> b) -> a -> b
$ NonEmpty RoleName -> AllowlistScope
AllowlistScopeRoles NonEmpty RoleName
roles

instance ToJSON AllowlistScope where
  toJSON :: AllowlistScope -> Value
toJSON AllowlistScope
scope = case AllowlistScope
scope of
    AllowlistScope
AllowlistScopeGlobal -> [Pair] -> Value
object [Key
"global" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
True]
    AllowlistScopeRoles NonEmpty RoleName
roles -> [Pair] -> Value
object [Key
"global" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
False, Key
"roles" Key -> NonEmpty RoleName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NonEmpty RoleName
roles]

data AllowlistEntry = AllowlistEntry
  { AllowlistEntry -> CollectionName
aeCollection :: CollectionName,
    AllowlistEntry -> AllowlistScope
aeScope :: AllowlistScope
  }
  deriving (Int -> AllowlistEntry -> ShowS
[AllowlistEntry] -> ShowS
AllowlistEntry -> String
(Int -> AllowlistEntry -> ShowS)
-> (AllowlistEntry -> String)
-> ([AllowlistEntry] -> ShowS)
-> Show AllowlistEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AllowlistEntry -> ShowS
showsPrec :: Int -> AllowlistEntry -> ShowS
$cshow :: AllowlistEntry -> String
show :: AllowlistEntry -> String
$cshowList :: [AllowlistEntry] -> ShowS
showList :: [AllowlistEntry] -> ShowS
Show, AllowlistEntry -> AllowlistEntry -> Bool
(AllowlistEntry -> AllowlistEntry -> Bool)
-> (AllowlistEntry -> AllowlistEntry -> Bool) -> Eq AllowlistEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AllowlistEntry -> AllowlistEntry -> Bool
== :: AllowlistEntry -> AllowlistEntry -> Bool
$c/= :: AllowlistEntry -> AllowlistEntry -> Bool
/= :: AllowlistEntry -> AllowlistEntry -> Bool
Eq, (forall x. AllowlistEntry -> Rep AllowlistEntry x)
-> (forall x. Rep AllowlistEntry x -> AllowlistEntry)
-> Generic AllowlistEntry
forall x. Rep AllowlistEntry x -> AllowlistEntry
forall x. AllowlistEntry -> Rep AllowlistEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AllowlistEntry -> Rep AllowlistEntry x
from :: forall x. AllowlistEntry -> Rep AllowlistEntry x
$cto :: forall x. Rep AllowlistEntry x -> AllowlistEntry
to :: forall x. Rep AllowlistEntry x -> AllowlistEntry
Generic)

instance HasCodec AllowlistEntry where
  codec :: JSONCodec AllowlistEntry
codec =
    Text
-> ObjectCodec AllowlistEntry AllowlistEntry
-> JSONCodec AllowlistEntry
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"AllowlistEntry"
      (ObjectCodec AllowlistEntry AllowlistEntry
 -> JSONCodec AllowlistEntry)
-> ObjectCodec AllowlistEntry AllowlistEntry
-> JSONCodec AllowlistEntry
forall a b. (a -> b) -> a -> b
$ CollectionName -> AllowlistScope -> AllowlistEntry
AllowlistEntry
      (CollectionName -> AllowlistScope -> AllowlistEntry)
-> Codec Object AllowlistEntry CollectionName
-> Codec Object AllowlistEntry (AllowlistScope -> AllowlistEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec CollectionName CollectionName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"collection"
      ObjectCodec CollectionName CollectionName
-> (AllowlistEntry -> CollectionName)
-> Codec Object AllowlistEntry CollectionName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= AllowlistEntry -> CollectionName
aeCollection
        Codec Object AllowlistEntry (AllowlistScope -> AllowlistEntry)
-> Codec Object AllowlistEntry AllowlistScope
-> ObjectCodec AllowlistEntry AllowlistEntry
forall a b.
Codec Object AllowlistEntry (a -> b)
-> Codec Object AllowlistEntry a -> Codec Object AllowlistEntry b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> AllowlistScope -> ObjectCodec AllowlistScope AllowlistScope
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"scope" AllowlistScope
AllowlistScopeGlobal
      ObjectCodec AllowlistScope AllowlistScope
-> (AllowlistEntry -> AllowlistScope)
-> Codec Object AllowlistEntry AllowlistScope
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= AllowlistEntry -> AllowlistScope
aeScope

instance ToJSON AllowlistEntry where
  toJSON :: AllowlistEntry -> Value
toJSON = Options -> AllowlistEntry -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: AllowlistEntry -> Encoding
toEncoding = Options -> AllowlistEntry -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

instance FromJSON AllowlistEntry where
  parseJSON :: Value -> Parser AllowlistEntry
parseJSON = String
-> (Object -> Parser AllowlistEntry)
-> Value
-> Parser AllowlistEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AllowlistEntry" \Object
o -> do
    CollectionName
collectionName <- Object
o Object -> Key -> Parser CollectionName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"collection"
    AllowlistScope
scope <- Object
o Object -> Key -> Parser (Maybe AllowlistScope)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scope" Parser (Maybe AllowlistScope)
-> AllowlistScope -> Parser AllowlistScope
forall a. Parser (Maybe a) -> a -> Parser a
.!= AllowlistScope
AllowlistScopeGlobal
    AllowlistEntry -> Parser AllowlistEntry
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AllowlistEntry -> Parser AllowlistEntry)
-> AllowlistEntry -> Parser AllowlistEntry
forall a b. (a -> b) -> a -> b
$ CollectionName -> AllowlistScope -> AllowlistEntry
AllowlistEntry CollectionName
collectionName AllowlistScope
scope

-- | Wrap 'AllowlistEntry' with a FromJSON instance that requires 'scope' to be set.
newtype UpdateScopeOfCollectionInAllowlist = UpdateScopeOfCollectionInAllowlist AllowlistEntry

instance FromJSON UpdateScopeOfCollectionInAllowlist where
  parseJSON :: Value -> Parser UpdateScopeOfCollectionInAllowlist
parseJSON = String
-> (Object -> Parser UpdateScopeOfCollectionInAllowlist)
-> Value
-> Parser UpdateScopeOfCollectionInAllowlist
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UpdateScopeOfCollectionInAllowlist" \Object
o -> do
    CollectionName
collectionName <- Object
o Object -> Key -> Parser CollectionName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"collection"
    AllowlistScope
scope <- Object
o Object -> Key -> Parser AllowlistScope
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"scope"
    UpdateScopeOfCollectionInAllowlist
-> Parser UpdateScopeOfCollectionInAllowlist
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdateScopeOfCollectionInAllowlist
 -> Parser UpdateScopeOfCollectionInAllowlist)
-> UpdateScopeOfCollectionInAllowlist
-> Parser UpdateScopeOfCollectionInAllowlist
forall a b. (a -> b) -> a -> b
$ AllowlistEntry -> UpdateScopeOfCollectionInAllowlist
UpdateScopeOfCollectionInAllowlist (AllowlistEntry -> UpdateScopeOfCollectionInAllowlist)
-> AllowlistEntry -> UpdateScopeOfCollectionInAllowlist
forall a b. (a -> b) -> a -> b
$ CollectionName -> AllowlistScope -> AllowlistEntry
AllowlistEntry CollectionName
collectionName AllowlistScope
scope

type MetadataAllowlist = InsOrdHashMap CollectionName AllowlistEntry

metadataAllowlistInsert ::
  AllowlistEntry -> MetadataAllowlist -> Either Text MetadataAllowlist
metadataAllowlistInsert :: AllowlistEntry
-> MetadataAllowlist -> Either Text MetadataAllowlist
metadataAllowlistInsert entry :: AllowlistEntry
entry@(AllowlistEntry CollectionName
coll AllowlistScope
_) MetadataAllowlist
al =
  (Maybe AllowlistEntry -> Either Text (Maybe AllowlistEntry))
-> CollectionName
-> MetadataAllowlist
-> Either Text MetadataAllowlist
forall (f :: * -> *) k v.
(Functor f, Hashable k) =>
(Maybe v -> f (Maybe v))
-> k -> InsOrdHashMap k v -> f (InsOrdHashMap k v)
InsOrdHashMap.alterF Maybe AllowlistEntry -> Either Text (Maybe AllowlistEntry)
insertIfAbsent CollectionName
coll MetadataAllowlist
al
  where
    insertIfAbsent :: Maybe AllowlistEntry -> Either Text (Maybe AllowlistEntry)
insertIfAbsent = \case
      Maybe AllowlistEntry
Nothing -> Maybe AllowlistEntry -> Either Text (Maybe AllowlistEntry)
forall a b. b -> Either a b
Right (AllowlistEntry -> Maybe AllowlistEntry
forall a. a -> Maybe a
Just AllowlistEntry
entry)
      Just AllowlistEntry
_ ->
        Text -> Either Text (Maybe AllowlistEntry)
forall a b. a -> Either a b
Left
          (Text -> Either Text (Maybe AllowlistEntry))
-> Text -> Either Text (Maybe AllowlistEntry)
forall a b. (a -> b) -> a -> b
$ Text
"collection "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CollectionName
coll
          CollectionName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" already exists in the allowlist, scope ignored;"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to change scope, use update_scope_of_collection_in_allowlist"

metadataAllowlistUpdateScope ::
  AllowlistEntry -> MetadataAllowlist -> Either Text MetadataAllowlist
metadataAllowlistUpdateScope :: AllowlistEntry
-> MetadataAllowlist -> Either Text MetadataAllowlist
metadataAllowlistUpdateScope entry :: AllowlistEntry
entry@(AllowlistEntry CollectionName
coll AllowlistScope
_) MetadataAllowlist
al =
  (Maybe AllowlistEntry -> Either Text (Maybe AllowlistEntry))
-> CollectionName
-> MetadataAllowlist
-> Either Text MetadataAllowlist
forall (f :: * -> *) k v.
(Functor f, Hashable k) =>
(Maybe v -> f (Maybe v))
-> k -> InsOrdHashMap k v -> f (InsOrdHashMap k v)
InsOrdHashMap.alterF Maybe AllowlistEntry -> Either Text (Maybe AllowlistEntry)
setIfPresent CollectionName
coll MetadataAllowlist
al
  where
    setIfPresent :: Maybe AllowlistEntry -> Either Text (Maybe AllowlistEntry)
setIfPresent = \case
      Just AllowlistEntry
_ -> Maybe AllowlistEntry -> Either Text (Maybe AllowlistEntry)
forall a b. b -> Either a b
Right (AllowlistEntry -> Maybe AllowlistEntry
forall a. a -> Maybe a
Just AllowlistEntry
entry)
      Maybe AllowlistEntry
Nothing -> Text -> Either Text (Maybe AllowlistEntry)
forall a b. a -> Either a b
Left (Text -> Either Text (Maybe AllowlistEntry))
-> Text -> Either Text (Maybe AllowlistEntry)
forall a b. (a -> b) -> a -> b
$ Text
"collection " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CollectionName
coll CollectionName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" doesn't exist in the allowlist"

-- | Produce a list of all collections in the allowlist.
-- This is used in 'runDropCollection' to function to ensure that we don't delete
-- any collections which are referred to in the allowlist.
metadataAllowlistAllCollections :: MetadataAllowlist -> [CollectionName]
metadataAllowlistAllCollections :: MetadataAllowlist -> [CollectionName]
metadataAllowlistAllCollections = InsOrdHashMap CollectionName CollectionName -> [CollectionName]
forall a. InsOrdHashMap CollectionName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (InsOrdHashMap CollectionName CollectionName -> [CollectionName])
-> (MetadataAllowlist
    -> InsOrdHashMap CollectionName CollectionName)
-> MetadataAllowlist
-> [CollectionName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AllowlistEntry -> CollectionName)
-> MetadataAllowlist -> InsOrdHashMap CollectionName CollectionName
forall v1 v2 k.
(v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
InsOrdHashMap.map AllowlistEntry -> CollectionName
aeCollection

-- | A query stripped of typenames. A query is allowed if it occurs
-- in an allowed query collection after normalization.
--
-- Compare docs/graphql/core/deployment/allow-list.rst.
newtype NormalizedQuery = NormalizedQuery {NormalizedQuery -> ExecutableDocument Name
unNormalizedQuery :: G.ExecutableDocument G.Name}
  deriving (Int -> NormalizedQuery -> ShowS
[NormalizedQuery] -> ShowS
NormalizedQuery -> String
(Int -> NormalizedQuery -> ShowS)
-> (NormalizedQuery -> String)
-> ([NormalizedQuery] -> ShowS)
-> Show NormalizedQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NormalizedQuery -> ShowS
showsPrec :: Int -> NormalizedQuery -> ShowS
$cshow :: NormalizedQuery -> String
show :: NormalizedQuery -> String
$cshowList :: [NormalizedQuery] -> ShowS
showList :: [NormalizedQuery] -> ShowS
Show, NormalizedQuery -> NormalizedQuery -> Bool
(NormalizedQuery -> NormalizedQuery -> Bool)
-> (NormalizedQuery -> NormalizedQuery -> Bool)
-> Eq NormalizedQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NormalizedQuery -> NormalizedQuery -> Bool
== :: NormalizedQuery -> NormalizedQuery -> Bool
$c/= :: NormalizedQuery -> NormalizedQuery -> Bool
/= :: NormalizedQuery -> NormalizedQuery -> Bool
Eq, Eq NormalizedQuery
Eq NormalizedQuery
-> (Int -> NormalizedQuery -> Int)
-> (NormalizedQuery -> Int)
-> Hashable NormalizedQuery
Int -> NormalizedQuery -> Int
NormalizedQuery -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> NormalizedQuery -> Int
hashWithSalt :: Int -> NormalizedQuery -> Int
$chash :: NormalizedQuery -> Int
hash :: NormalizedQuery -> Int
Hashable, [NormalizedQuery] -> Value
[NormalizedQuery] -> Encoding
NormalizedQuery -> Value
NormalizedQuery -> Encoding
(NormalizedQuery -> Value)
-> (NormalizedQuery -> Encoding)
-> ([NormalizedQuery] -> Value)
-> ([NormalizedQuery] -> Encoding)
-> ToJSON NormalizedQuery
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: NormalizedQuery -> Value
toJSON :: NormalizedQuery -> Value
$ctoEncoding :: NormalizedQuery -> Encoding
toEncoding :: NormalizedQuery -> Encoding
$ctoJSONList :: [NormalizedQuery] -> Value
toJSONList :: [NormalizedQuery] -> Value
$ctoEncodingList :: [NormalizedQuery] -> Encoding
toEncodingList :: [NormalizedQuery] -> Encoding
ToJSON)

-- | Normalize query for comparison by stripping type names.
normalizeQuery :: G.ExecutableDocument G.Name -> NormalizedQuery
normalizeQuery :: ExecutableDocument Name -> NormalizedQuery
normalizeQuery =
  ExecutableDocument Name -> NormalizedQuery
NormalizedQuery
    (ExecutableDocument Name -> NormalizedQuery)
-> (ExecutableDocument Name -> ExecutableDocument Name)
-> ExecutableDocument Name
-> NormalizedQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ExecutableDefinition Name] -> ExecutableDocument Name
forall var. [ExecutableDefinition var] -> ExecutableDocument var
G.ExecutableDocument
    ([ExecutableDefinition Name] -> ExecutableDocument Name)
-> (ExecutableDocument Name -> [ExecutableDefinition Name])
-> ExecutableDocument Name
-> ExecutableDocument Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExecutableDefinition Name -> ExecutableDefinition Name)
-> [ExecutableDefinition Name] -> [ExecutableDefinition Name]
forall a b. (a -> b) -> [a] -> [b]
map ExecutableDefinition Name -> ExecutableDefinition Name
forall var. ExecutableDefinition var -> ExecutableDefinition var
filterExecDef
    ([ExecutableDefinition Name] -> [ExecutableDefinition Name])
-> (ExecutableDocument Name -> [ExecutableDefinition Name])
-> ExecutableDocument Name
-> [ExecutableDefinition Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecutableDocument Name -> [ExecutableDefinition Name]
forall var. ExecutableDocument var -> [ExecutableDefinition var]
G.getExecutableDefinitions
  where
    filterExecDef :: G.ExecutableDefinition var -> G.ExecutableDefinition var
    filterExecDef :: forall var. ExecutableDefinition var -> ExecutableDefinition var
filterExecDef = \case
      G.ExecutableDefinitionOperation OperationDefinition FragmentSpread var
opDef ->
        OperationDefinition FragmentSpread var -> ExecutableDefinition var
forall var.
OperationDefinition FragmentSpread var -> ExecutableDefinition var
G.ExecutableDefinitionOperation (OperationDefinition FragmentSpread var
 -> ExecutableDefinition var)
-> OperationDefinition FragmentSpread var
-> ExecutableDefinition var
forall a b. (a -> b) -> a -> b
$ OperationDefinition FragmentSpread var
-> OperationDefinition FragmentSpread var
forall {frag :: * -> *} {var}.
OperationDefinition frag var -> OperationDefinition frag var
filterOpDef OperationDefinition FragmentSpread var
opDef
      G.ExecutableDefinitionFragment FragmentDefinition
fragDef ->
        let newSelset :: [Selection FragmentSpread Name]
newSelset = [Selection FragmentSpread Name] -> [Selection FragmentSpread Name]
forall (frag :: * -> *) var'.
[Selection frag var'] -> [Selection frag var']
filterSelSet ([Selection FragmentSpread Name]
 -> [Selection FragmentSpread Name])
-> [Selection FragmentSpread Name]
-> [Selection FragmentSpread Name]
forall a b. (a -> b) -> a -> b
$ FragmentDefinition -> [Selection FragmentSpread Name]
G._fdSelectionSet FragmentDefinition
fragDef
         in FragmentDefinition -> ExecutableDefinition var
forall var. FragmentDefinition -> ExecutableDefinition var
G.ExecutableDefinitionFragment FragmentDefinition
fragDef {_fdSelectionSet :: [Selection FragmentSpread Name]
G._fdSelectionSet = [Selection FragmentSpread Name]
newSelset}

    filterOpDef :: OperationDefinition frag var -> OperationDefinition frag var
filterOpDef = \case
      G.OperationDefinitionTyped TypedOperationDefinition frag var
typeOpDef ->
        let newSelset :: [Selection frag var]
newSelset = [Selection frag var] -> [Selection frag var]
forall (frag :: * -> *) var'.
[Selection frag var'] -> [Selection frag var']
filterSelSet ([Selection frag var] -> [Selection frag var])
-> [Selection frag var] -> [Selection frag var]
forall a b. (a -> b) -> a -> b
$ TypedOperationDefinition frag var -> [Selection frag var]
forall (frag :: * -> *) var.
TypedOperationDefinition frag var -> SelectionSet frag var
G._todSelectionSet TypedOperationDefinition frag var
typeOpDef
         in TypedOperationDefinition frag var -> OperationDefinition frag var
forall (frag :: * -> *) var.
TypedOperationDefinition frag var -> OperationDefinition frag var
G.OperationDefinitionTyped TypedOperationDefinition frag var
typeOpDef {_todSelectionSet :: [Selection frag var]
G._todSelectionSet = [Selection frag var]
newSelset}
      G.OperationDefinitionUnTyped [Selection frag var]
selset ->
        [Selection frag var] -> OperationDefinition frag var
forall (frag :: * -> *) var.
SelectionSet frag var -> OperationDefinition frag var
G.OperationDefinitionUnTyped ([Selection frag var] -> OperationDefinition frag var)
-> [Selection frag var] -> OperationDefinition frag var
forall a b. (a -> b) -> a -> b
$ [Selection frag var] -> [Selection frag var]
forall (frag :: * -> *) var'.
[Selection frag var'] -> [Selection frag var']
filterSelSet [Selection frag var]
selset

    filterSelSet :: [G.Selection frag var'] -> [G.Selection frag var']
    filterSelSet :: forall (frag :: * -> *) var'.
[Selection frag var'] -> [Selection frag var']
filterSelSet = (Selection frag var' -> Maybe (Selection frag var'))
-> [Selection frag var'] -> [Selection frag var']
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe Selection frag var' -> Maybe (Selection frag var')
forall (frag :: * -> *) var'.
Selection frag var' -> Maybe (Selection frag var')
filterSel

    filterSel :: G.Selection frag var' -> Maybe (G.Selection frag var')
    filterSel :: forall (frag :: * -> *) var'.
Selection frag var' -> Maybe (Selection frag var')
filterSel Selection frag var'
s = case Selection frag var'
s of
      G.SelectionField Field frag var'
f ->
        if Field frag var' -> Name
forall (frag :: * -> *) var. Field frag var -> Name
G._fName Field frag var'
f Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName.___typename
          then Maybe (Selection frag var')
forall a. Maybe a
Nothing
          else
            let newSelset :: [Selection frag var']
newSelset = [Selection frag var'] -> [Selection frag var']
forall (frag :: * -> *) var'.
[Selection frag var'] -> [Selection frag var']
filterSelSet ([Selection frag var'] -> [Selection frag var'])
-> [Selection frag var'] -> [Selection frag var']
forall a b. (a -> b) -> a -> b
$ Field frag var' -> [Selection frag var']
forall (frag :: * -> *) var.
Field frag var -> SelectionSet frag var
G._fSelectionSet Field frag var'
f
             in Selection frag var' -> Maybe (Selection frag var')
forall a. a -> Maybe a
Just (Selection frag var' -> Maybe (Selection frag var'))
-> Selection frag var' -> Maybe (Selection frag var')
forall a b. (a -> b) -> a -> b
$ Field frag var' -> Selection frag var'
forall (frag :: * -> *) var. Field frag var -> Selection frag var
G.SelectionField Field frag var'
f {_fSelectionSet :: [Selection frag var']
G._fSelectionSet = [Selection frag var']
newSelset}
      Selection frag var'
_ -> Selection frag var' -> Maybe (Selection frag var')
forall a. a -> Maybe a
Just Selection frag var'
s

-- | InlinedAllowlist is the data type with which the allowlist is represented
--   in the schema cache, it contains a global and a per role allowlist and when
--   allowlist is enabled in the graphql-engine, the incoming query for a non-admin
--   role should either be in the global allowlist or in the given role's role
--   based allowlist.
--
--   Essentially, it's a memoization of 'allowlistAllowsQuery' implemented
--   in terms of 'MetadataAllowlist'.
data InlinedAllowlist = InlinedAllowlist
  { InlinedAllowlist -> HashSet NormalizedQuery
iaGlobal :: HashSet NormalizedQuery,
    InlinedAllowlist -> HashMap RoleName (HashSet NormalizedQuery)
iaPerRole :: HashMap RoleName (HashSet NormalizedQuery)
  }
  deriving stock (Int -> InlinedAllowlist -> ShowS
[InlinedAllowlist] -> ShowS
InlinedAllowlist -> String
(Int -> InlinedAllowlist -> ShowS)
-> (InlinedAllowlist -> String)
-> ([InlinedAllowlist] -> ShowS)
-> Show InlinedAllowlist
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InlinedAllowlist -> ShowS
showsPrec :: Int -> InlinedAllowlist -> ShowS
$cshow :: InlinedAllowlist -> String
show :: InlinedAllowlist -> String
$cshowList :: [InlinedAllowlist] -> ShowS
showList :: [InlinedAllowlist] -> ShowS
Show, InlinedAllowlist -> InlinedAllowlist -> Bool
(InlinedAllowlist -> InlinedAllowlist -> Bool)
-> (InlinedAllowlist -> InlinedAllowlist -> Bool)
-> Eq InlinedAllowlist
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InlinedAllowlist -> InlinedAllowlist -> Bool
== :: InlinedAllowlist -> InlinedAllowlist -> Bool
$c/= :: InlinedAllowlist -> InlinedAllowlist -> Bool
/= :: InlinedAllowlist -> InlinedAllowlist -> Bool
Eq, (forall x. InlinedAllowlist -> Rep InlinedAllowlist x)
-> (forall x. Rep InlinedAllowlist x -> InlinedAllowlist)
-> Generic InlinedAllowlist
forall x. Rep InlinedAllowlist x -> InlinedAllowlist
forall x. InlinedAllowlist -> Rep InlinedAllowlist x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InlinedAllowlist -> Rep InlinedAllowlist x
from :: forall x. InlinedAllowlist -> Rep InlinedAllowlist x
$cto :: forall x. Rep InlinedAllowlist x -> InlinedAllowlist
to :: forall x. Rep InlinedAllowlist x -> InlinedAllowlist
Generic)

instance ToJSON InlinedAllowlist where
  toJSON :: InlinedAllowlist -> Value
toJSON = Options -> InlinedAllowlist -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: InlinedAllowlist -> Encoding
toEncoding = Options -> InlinedAllowlist -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

inlineAllowlist :: QueryCollections -> MetadataAllowlist -> InlinedAllowlist
inlineAllowlist :: QueryCollections -> MetadataAllowlist -> InlinedAllowlist
inlineAllowlist QueryCollections
collections MetadataAllowlist
allowlist = HashSet NormalizedQuery
-> HashMap RoleName (HashSet NormalizedQuery) -> InlinedAllowlist
InlinedAllowlist HashSet NormalizedQuery
global HashMap RoleName (HashSet NormalizedQuery)
perRole
  where
    globalCollections :: [CollectionName]
    globalCollections :: [CollectionName]
globalCollections =
      [CollectionName
coll | AllowlistEntry CollectionName
coll AllowlistScope
AllowlistScopeGlobal <- MetadataAllowlist -> [AllowlistEntry]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems MetadataAllowlist
allowlist]
    perRoleCollections :: HashMap RoleName [CollectionName]
    perRoleCollections :: HashMap RoleName [CollectionName]
perRoleCollections =
      [(CollectionName, [RoleName])] -> HashMap RoleName [CollectionName]
forall b a. Hashable b => [(a, [b])] -> HashMap b [a]
inverseMap
        ([(CollectionName, [RoleName])]
 -> HashMap RoleName [CollectionName])
-> [(CollectionName, [RoleName])]
-> HashMap RoleName [CollectionName]
forall a b. (a -> b) -> a -> b
$ [ (CollectionName
coll, NonEmpty RoleName -> [RoleName]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty RoleName
roles)
            | AllowlistEntry CollectionName
coll (AllowlistScopeRoles NonEmpty RoleName
roles) <- MetadataAllowlist -> [AllowlistEntry]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems MetadataAllowlist
allowlist
          ]

    inverseMap :: (Hashable b) => [(a, [b])] -> HashMap b [a]
    inverseMap :: forall b a. Hashable b => [(a, [b])] -> HashMap b [a]
inverseMap = ([a] -> [a] -> [a]) -> [(b, [a])] -> HashMap b [a]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HashMap.fromListWith [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
(<>) ([(b, [a])] -> HashMap b [a])
-> ([(a, [b])] -> [(b, [a])]) -> [(a, [b])] -> HashMap b [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [b]) -> [(b, [a])]) -> [(a, [b])] -> [(b, [a])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(a
c, [b]
rs) -> [(b
r, [a
c]) | b
r <- [b]
rs])

    global :: HashSet NormalizedQuery
global = [CollectionName] -> HashSet NormalizedQuery
inlineQueries [CollectionName]
globalCollections
    perRole :: HashMap RoleName (HashSet NormalizedQuery)
perRole = [CollectionName] -> HashSet NormalizedQuery
inlineQueries ([CollectionName] -> HashSet NormalizedQuery)
-> HashMap RoleName [CollectionName]
-> HashMap RoleName (HashSet NormalizedQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap RoleName [CollectionName]
perRoleCollections

    -- given a hashset of collections, look up what queries are in each
    -- collection, and inline them all into a hashset of queries
    inlineQueries :: [CollectionName] -> HashSet NormalizedQuery
    inlineQueries :: [CollectionName] -> HashSet NormalizedQuery
inlineQueries =
      (CollectionName -> [ExecutableDocument Name])
-> [CollectionName] -> [ExecutableDocument Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CollectionName -> [ExecutableDocument Name]
lookupQueries
        ([CollectionName] -> [ExecutableDocument Name])
-> ([ExecutableDocument Name] -> HashSet NormalizedQuery)
-> [CollectionName]
-> HashSet NormalizedQuery
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (ExecutableDocument Name -> NormalizedQuery)
-> [ExecutableDocument Name] -> [NormalizedQuery]
forall a b. (a -> b) -> [a] -> [b]
map ExecutableDocument Name -> NormalizedQuery
normalizeQuery
        ([ExecutableDocument Name] -> [NormalizedQuery])
-> ([NormalizedQuery] -> HashSet NormalizedQuery)
-> [ExecutableDocument Name]
-> HashSet NormalizedQuery
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [NormalizedQuery] -> HashSet NormalizedQuery
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList

    lookupQueries :: CollectionName -> [G.ExecutableDocument G.Name]
    lookupQueries :: CollectionName -> [ExecutableDocument Name]
lookupQueries CollectionName
coll =
      [ExecutableDocument Name]
-> (CreateCollection -> [ExecutableDocument Name])
-> Maybe CreateCollection
-> [ExecutableDocument Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CreateCollection -> [ExecutableDocument Name]
collectionQueries (Maybe CreateCollection -> [ExecutableDocument Name])
-> Maybe CreateCollection -> [ExecutableDocument Name]
forall a b. (a -> b) -> a -> b
$ CollectionName -> QueryCollections -> Maybe CreateCollection
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup CollectionName
coll QueryCollections
collections

-- | The mode in which the allowlist functions. In global mode,
-- collections with non-global scope are ignored.
data AllowlistMode = AllowlistModeGlobalOnly | AllowlistModeFull

allowlistAllowsQuery ::
  InlinedAllowlist -> AllowlistMode -> RoleName -> G.ExecutableDocument G.Name -> Bool
allowlistAllowsQuery :: InlinedAllowlist
-> AllowlistMode -> RoleName -> ExecutableDocument Name -> Bool
allowlistAllowsQuery (InlinedAllowlist HashSet NormalizedQuery
global HashMap RoleName (HashSet NormalizedQuery)
perRole) AllowlistMode
mode RoleName
role ExecutableDocument Name
query =
  case AllowlistMode
mode of
    AllowlistMode
AllowlistModeGlobalOnly -> HashSet NormalizedQuery -> Bool
inAllowlist HashSet NormalizedQuery
global
    AllowlistMode
AllowlistModeFull -> HashSet NormalizedQuery -> Bool
inAllowlist HashSet NormalizedQuery
global Bool -> Bool -> Bool
|| HashSet NormalizedQuery -> Bool
inAllowlist HashSet NormalizedQuery
roleAllowlist
  where
    inAllowlist :: HashSet NormalizedQuery -> Bool
inAllowlist = NormalizedQuery -> HashSet NormalizedQuery -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
S.member (ExecutableDocument Name -> NormalizedQuery
normalizeQuery ExecutableDocument Name
query)
    roleAllowlist :: HashSet NormalizedQuery
roleAllowlist = HashSet NormalizedQuery
-> RoleName
-> HashMap RoleName (HashSet NormalizedQuery)
-> HashSet NormalizedQuery
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.findWithDefault HashSet NormalizedQuery
forall a. Monoid a => a
mempty RoleName
role HashMap RoleName (HashSet NormalizedQuery)
perRole