{-# LANGUAGE TemplateHaskell #-}

module Hasura.RemoteSchema.SchemaCache.Types
  ( RemoteSchemaRelationshipsG,
    IntrospectionResult (..),
    RemoteSchemaCtxG (..),
    PartiallyResolvedRemoteRelationship (..),
    PartiallyResolvedRemoteSchemaCtxG,
    rscName,
    rscInfo,
    rscIntroOriginal,
    rscRawIntrospectionResult,
    rscPermissions,
    rscRemoteRelationships,
    RemoteSchemaCustomizer (..),
    RemoteSchemaInfo (..),
    ValidatedRemoteSchemaDef (..),
    hasTypeOrFieldCustomizations,
    identityCustomizer,
    remoteSchemaCustomizeFieldName,
    remoteSchemaCustomizeTypeName,
    validateRemoteSchemaCustomization,
    validateRemoteSchemaDef,
    CustomizeRemoteFieldName (..),
    withRemoteFieldNameCustomization,
    RemoteSchemaInputValueDefinition (..),
    RemoteSchemaIntrospection (..),
    RemoteSchemaVariable (..),
    SessionArgumentPresetInfo (..),
    lookupEnum,
    lookupInputObject,
    lookupInterface,
    lookupObject,
    lookupScalar,
    lookupType,
    lookupUnion,
    getTypeName,
    FieldCall (..),
    RemoteArguments (..),
    RemoteFields (..),
    RemoteSchemaFieldInfo (..),
    graphQLValueToJSON,
    LHSIdentifier (..),
    remoteSchemaToLHSIdentifier,
    lhsIdentifierToGraphQLName,
  )
where

import Control.Lens
import Data.Aeson qualified as J
import Data.Aeson.TH qualified as J
import Data.ByteString.Lazy qualified as BL
import Data.Char qualified as C
import Data.Environment qualified as Env
import Data.Has
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as Set
import Data.Monoid
import Data.Text qualified as T
import Data.Text.Extended
import Data.URL.Template (printTemplate)
import Hasura.Base.Error
import Hasura.GraphQL.Parser.Variable
import Hasura.GraphQL.Schema.Typename
import Hasura.Prelude
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Headers (HeaderConf (..))
import Hasura.RQL.Types.Roles (RoleName)
import Hasura.RemoteSchema.Metadata
import Hasura.Session (SessionVariable)
import Language.GraphQL.Draft.Syntax qualified as G
import Network.URI.Extended qualified as N
import Witherable (Filterable (..))

type RemoteSchemaRelationshipsG remoteFieldInfo =
  InsOrdHashMap G.Name (InsOrdHashMap RelName remoteFieldInfo)

data IntrospectionResult = IntrospectionResult
  { IntrospectionResult -> RemoteSchemaIntrospection
irDoc :: RemoteSchemaIntrospection,
    IntrospectionResult -> Name
irQueryRoot :: G.Name,
    IntrospectionResult -> Maybe Name
irMutationRoot :: Maybe G.Name,
    IntrospectionResult -> Maybe Name
irSubscriptionRoot :: Maybe G.Name
  }
  deriving (Int -> IntrospectionResult -> ShowS
[IntrospectionResult] -> ShowS
IntrospectionResult -> String
(Int -> IntrospectionResult -> ShowS)
-> (IntrospectionResult -> String)
-> ([IntrospectionResult] -> ShowS)
-> Show IntrospectionResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntrospectionResult -> ShowS
showsPrec :: Int -> IntrospectionResult -> ShowS
$cshow :: IntrospectionResult -> String
show :: IntrospectionResult -> String
$cshowList :: [IntrospectionResult] -> ShowS
showList :: [IntrospectionResult] -> ShowS
Show, IntrospectionResult -> IntrospectionResult -> Bool
(IntrospectionResult -> IntrospectionResult -> Bool)
-> (IntrospectionResult -> IntrospectionResult -> Bool)
-> Eq IntrospectionResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntrospectionResult -> IntrospectionResult -> Bool
== :: IntrospectionResult -> IntrospectionResult -> Bool
$c/= :: IntrospectionResult -> IntrospectionResult -> Bool
/= :: IntrospectionResult -> IntrospectionResult -> Bool
Eq, (forall x. IntrospectionResult -> Rep IntrospectionResult x)
-> (forall x. Rep IntrospectionResult x -> IntrospectionResult)
-> Generic IntrospectionResult
forall x. Rep IntrospectionResult x -> IntrospectionResult
forall x. IntrospectionResult -> Rep IntrospectionResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IntrospectionResult -> Rep IntrospectionResult x
from :: forall x. IntrospectionResult -> Rep IntrospectionResult x
$cto :: forall x. Rep IntrospectionResult x -> IntrospectionResult
to :: forall x. Rep IntrospectionResult x -> IntrospectionResult
Generic)

-- | The resolved information of a remote schema. It is parameterized by
-- `remoteFieldInfo` so as to work on an arbitrary 'remote relationship'
-- TODO: Get rid of this 'G' suffix using pattern synonyms or qualified
-- usage
data RemoteSchemaCtxG remoteFieldInfo = RemoteSchemaCtx
  { forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> RemoteSchemaName
_rscName :: RemoteSchemaName,
    -- | Original remote schema without customizations
    forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> IntrospectionResult
_rscIntroOriginal :: IntrospectionResult,
    forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> RemoteSchemaInfo
_rscInfo :: RemoteSchemaInfo,
    -- | The raw response from the introspection query against the remote server.
    -- We store this so we can efficiently service 'introspect_remote_schema'.
    forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> ByteString
_rscRawIntrospectionResult :: BL.ByteString,
    forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo
-> HashMap RoleName IntrospectionResult
_rscPermissions :: HashMap.HashMap RoleName IntrospectionResult,
    forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo
-> RemoteSchemaRelationshipsG remoteFieldInfo
_rscRemoteRelationships :: RemoteSchemaRelationshipsG remoteFieldInfo
  }
  deriving (RemoteSchemaCtxG remoteFieldInfo
-> RemoteSchemaCtxG remoteFieldInfo -> Bool
(RemoteSchemaCtxG remoteFieldInfo
 -> RemoteSchemaCtxG remoteFieldInfo -> Bool)
-> (RemoteSchemaCtxG remoteFieldInfo
    -> RemoteSchemaCtxG remoteFieldInfo -> Bool)
-> Eq (RemoteSchemaCtxG remoteFieldInfo)
forall remoteFieldInfo.
Eq remoteFieldInfo =>
RemoteSchemaCtxG remoteFieldInfo
-> RemoteSchemaCtxG remoteFieldInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall remoteFieldInfo.
Eq remoteFieldInfo =>
RemoteSchemaCtxG remoteFieldInfo
-> RemoteSchemaCtxG remoteFieldInfo -> Bool
== :: RemoteSchemaCtxG remoteFieldInfo
-> RemoteSchemaCtxG remoteFieldInfo -> Bool
$c/= :: forall remoteFieldInfo.
Eq remoteFieldInfo =>
RemoteSchemaCtxG remoteFieldInfo
-> RemoteSchemaCtxG remoteFieldInfo -> Bool
/= :: RemoteSchemaCtxG remoteFieldInfo
-> RemoteSchemaCtxG remoteFieldInfo -> Bool
Eq, (forall a b. (a -> b) -> RemoteSchemaCtxG a -> RemoteSchemaCtxG b)
-> (forall a b. a -> RemoteSchemaCtxG b -> RemoteSchemaCtxG a)
-> Functor RemoteSchemaCtxG
forall a b. a -> RemoteSchemaCtxG b -> RemoteSchemaCtxG a
forall a b. (a -> b) -> RemoteSchemaCtxG a -> RemoteSchemaCtxG b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RemoteSchemaCtxG a -> RemoteSchemaCtxG b
fmap :: forall a b. (a -> b) -> RemoteSchemaCtxG a -> RemoteSchemaCtxG b
$c<$ :: forall a b. a -> RemoteSchemaCtxG b -> RemoteSchemaCtxG a
<$ :: forall a b. a -> RemoteSchemaCtxG b -> RemoteSchemaCtxG a
Functor, (forall m. Monoid m => RemoteSchemaCtxG m -> m)
-> (forall m a. Monoid m => (a -> m) -> RemoteSchemaCtxG a -> m)
-> (forall m a. Monoid m => (a -> m) -> RemoteSchemaCtxG a -> m)
-> (forall a b. (a -> b -> b) -> b -> RemoteSchemaCtxG a -> b)
-> (forall a b. (a -> b -> b) -> b -> RemoteSchemaCtxG a -> b)
-> (forall b a. (b -> a -> b) -> b -> RemoteSchemaCtxG a -> b)
-> (forall b a. (b -> a -> b) -> b -> RemoteSchemaCtxG a -> b)
-> (forall a. (a -> a -> a) -> RemoteSchemaCtxG a -> a)
-> (forall a. (a -> a -> a) -> RemoteSchemaCtxG a -> a)
-> (forall a. RemoteSchemaCtxG a -> [a])
-> (forall a. RemoteSchemaCtxG a -> Bool)
-> (forall a. RemoteSchemaCtxG a -> Int)
-> (forall a. Eq a => a -> RemoteSchemaCtxG a -> Bool)
-> (forall a. Ord a => RemoteSchemaCtxG a -> a)
-> (forall a. Ord a => RemoteSchemaCtxG a -> a)
-> (forall a. Num a => RemoteSchemaCtxG a -> a)
-> (forall a. Num a => RemoteSchemaCtxG a -> a)
-> Foldable RemoteSchemaCtxG
forall a. Eq a => a -> RemoteSchemaCtxG a -> Bool
forall a. Num a => RemoteSchemaCtxG a -> a
forall a. Ord a => RemoteSchemaCtxG a -> a
forall m. Monoid m => RemoteSchemaCtxG m -> m
forall a. RemoteSchemaCtxG a -> Bool
forall a. RemoteSchemaCtxG a -> Int
forall a. RemoteSchemaCtxG a -> [a]
forall a. (a -> a -> a) -> RemoteSchemaCtxG a -> a
forall m a. Monoid m => (a -> m) -> RemoteSchemaCtxG a -> m
forall b a. (b -> a -> b) -> b -> RemoteSchemaCtxG a -> b
forall a b. (a -> b -> b) -> b -> RemoteSchemaCtxG a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => RemoteSchemaCtxG m -> m
fold :: forall m. Monoid m => RemoteSchemaCtxG m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> RemoteSchemaCtxG a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> RemoteSchemaCtxG a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> RemoteSchemaCtxG a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> RemoteSchemaCtxG a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> RemoteSchemaCtxG a -> b
foldr :: forall a b. (a -> b -> b) -> b -> RemoteSchemaCtxG a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> RemoteSchemaCtxG a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> RemoteSchemaCtxG a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> RemoteSchemaCtxG a -> b
foldl :: forall b a. (b -> a -> b) -> b -> RemoteSchemaCtxG a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> RemoteSchemaCtxG a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> RemoteSchemaCtxG a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> RemoteSchemaCtxG a -> a
foldr1 :: forall a. (a -> a -> a) -> RemoteSchemaCtxG a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> RemoteSchemaCtxG a -> a
foldl1 :: forall a. (a -> a -> a) -> RemoteSchemaCtxG a -> a
$ctoList :: forall a. RemoteSchemaCtxG a -> [a]
toList :: forall a. RemoteSchemaCtxG a -> [a]
$cnull :: forall a. RemoteSchemaCtxG a -> Bool
null :: forall a. RemoteSchemaCtxG a -> Bool
$clength :: forall a. RemoteSchemaCtxG a -> Int
length :: forall a. RemoteSchemaCtxG a -> Int
$celem :: forall a. Eq a => a -> RemoteSchemaCtxG a -> Bool
elem :: forall a. Eq a => a -> RemoteSchemaCtxG a -> Bool
$cmaximum :: forall a. Ord a => RemoteSchemaCtxG a -> a
maximum :: forall a. Ord a => RemoteSchemaCtxG a -> a
$cminimum :: forall a. Ord a => RemoteSchemaCtxG a -> a
minimum :: forall a. Ord a => RemoteSchemaCtxG a -> a
$csum :: forall a. Num a => RemoteSchemaCtxG a -> a
sum :: forall a. Num a => RemoteSchemaCtxG a -> a
$cproduct :: forall a. Num a => RemoteSchemaCtxG a -> a
product :: forall a. Num a => RemoteSchemaCtxG a -> a
Foldable, Functor RemoteSchemaCtxG
Foldable RemoteSchemaCtxG
Functor RemoteSchemaCtxG
-> Foldable RemoteSchemaCtxG
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> RemoteSchemaCtxG a -> f (RemoteSchemaCtxG b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RemoteSchemaCtxG (f a) -> f (RemoteSchemaCtxG a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RemoteSchemaCtxG a -> m (RemoteSchemaCtxG b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RemoteSchemaCtxG (m a) -> m (RemoteSchemaCtxG a))
-> Traversable RemoteSchemaCtxG
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
RemoteSchemaCtxG (m a) -> m (RemoteSchemaCtxG a)
forall (f :: * -> *) a.
Applicative f =>
RemoteSchemaCtxG (f a) -> f (RemoteSchemaCtxG a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RemoteSchemaCtxG a -> m (RemoteSchemaCtxG b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RemoteSchemaCtxG a -> f (RemoteSchemaCtxG b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RemoteSchemaCtxG a -> f (RemoteSchemaCtxG b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RemoteSchemaCtxG a -> f (RemoteSchemaCtxG b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
RemoteSchemaCtxG (f a) -> f (RemoteSchemaCtxG a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
RemoteSchemaCtxG (f a) -> f (RemoteSchemaCtxG a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RemoteSchemaCtxG a -> m (RemoteSchemaCtxG b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RemoteSchemaCtxG a -> m (RemoteSchemaCtxG b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
RemoteSchemaCtxG (m a) -> m (RemoteSchemaCtxG a)
sequence :: forall (m :: * -> *) a.
Monad m =>
RemoteSchemaCtxG (m a) -> m (RemoteSchemaCtxG a)
Traversable)

instance Filterable RemoteSchemaCtxG where
  filter :: forall a. (a -> Bool) -> RemoteSchemaCtxG a -> RemoteSchemaCtxG a
filter a -> Bool
f RemoteSchemaCtx {HashMap RoleName IntrospectionResult
ByteString
RemoteSchemaRelationshipsG a
RemoteSchemaName
RemoteSchemaInfo
IntrospectionResult
_rscName :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> RemoteSchemaName
_rscIntroOriginal :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> IntrospectionResult
_rscInfo :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> RemoteSchemaInfo
_rscRawIntrospectionResult :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> ByteString
_rscPermissions :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo
-> HashMap RoleName IntrospectionResult
_rscRemoteRelationships :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo
-> RemoteSchemaRelationshipsG remoteFieldInfo
_rscName :: RemoteSchemaName
_rscIntroOriginal :: IntrospectionResult
_rscInfo :: RemoteSchemaInfo
_rscRawIntrospectionResult :: ByteString
_rscPermissions :: HashMap RoleName IntrospectionResult
_rscRemoteRelationships :: RemoteSchemaRelationshipsG a
..} =
    RemoteSchemaCtx
      { _rscRemoteRelationships :: RemoteSchemaRelationshipsG a
_rscRemoteRelationships = (InsOrdHashMap RelName a -> InsOrdHashMap RelName a)
-> RemoteSchemaRelationshipsG a -> RemoteSchemaRelationshipsG a
forall a b.
(a -> b) -> InsOrdHashMap Name a -> InsOrdHashMap Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Bool) -> InsOrdHashMap RelName a -> InsOrdHashMap RelName a
forall a.
(a -> Bool) -> InsOrdHashMap RelName a -> InsOrdHashMap RelName a
forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
Witherable.filter a -> Bool
f) RemoteSchemaRelationshipsG a
_rscRemoteRelationships,
        HashMap RoleName IntrospectionResult
ByteString
RemoteSchemaName
RemoteSchemaInfo
IntrospectionResult
_rscName :: RemoteSchemaName
_rscIntroOriginal :: IntrospectionResult
_rscInfo :: RemoteSchemaInfo
_rscRawIntrospectionResult :: ByteString
_rscPermissions :: HashMap RoleName IntrospectionResult
_rscName :: RemoteSchemaName
_rscIntroOriginal :: IntrospectionResult
_rscInfo :: RemoteSchemaInfo
_rscRawIntrospectionResult :: ByteString
_rscPermissions :: HashMap RoleName IntrospectionResult
..
      }
  mapMaybe :: forall a b.
(a -> Maybe b) -> RemoteSchemaCtxG a -> RemoteSchemaCtxG b
mapMaybe a -> Maybe b
f RemoteSchemaCtx {HashMap RoleName IntrospectionResult
ByteString
RemoteSchemaRelationshipsG a
RemoteSchemaName
RemoteSchemaInfo
IntrospectionResult
_rscName :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> RemoteSchemaName
_rscIntroOriginal :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> IntrospectionResult
_rscInfo :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> RemoteSchemaInfo
_rscRawIntrospectionResult :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> ByteString
_rscPermissions :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo
-> HashMap RoleName IntrospectionResult
_rscRemoteRelationships :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo
-> RemoteSchemaRelationshipsG remoteFieldInfo
_rscName :: RemoteSchemaName
_rscIntroOriginal :: IntrospectionResult
_rscInfo :: RemoteSchemaInfo
_rscRawIntrospectionResult :: ByteString
_rscPermissions :: HashMap RoleName IntrospectionResult
_rscRemoteRelationships :: RemoteSchemaRelationshipsG a
..} =
    RemoteSchemaCtx
      { _rscRemoteRelationships :: RemoteSchemaRelationshipsG b
_rscRemoteRelationships = (InsOrdHashMap RelName a -> InsOrdHashMap RelName b)
-> RemoteSchemaRelationshipsG a -> RemoteSchemaRelationshipsG b
forall a b.
(a -> b) -> InsOrdHashMap Name a -> InsOrdHashMap Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Maybe b)
-> InsOrdHashMap RelName a -> InsOrdHashMap RelName b
forall a b.
(a -> Maybe b)
-> InsOrdHashMap RelName a -> InsOrdHashMap RelName b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f) RemoteSchemaRelationshipsG a
_rscRemoteRelationships,
        HashMap RoleName IntrospectionResult
ByteString
RemoteSchemaName
RemoteSchemaInfo
IntrospectionResult
_rscName :: RemoteSchemaName
_rscIntroOriginal :: IntrospectionResult
_rscInfo :: RemoteSchemaInfo
_rscRawIntrospectionResult :: ByteString
_rscPermissions :: HashMap RoleName IntrospectionResult
_rscName :: RemoteSchemaName
_rscIntroOriginal :: IntrospectionResult
_rscInfo :: RemoteSchemaInfo
_rscRawIntrospectionResult :: ByteString
_rscPermissions :: HashMap RoleName IntrospectionResult
..
      }

-- | Resolved information of a remote relationship with the local information
-- that we have. Currently this is only the typename on which the relationship
-- is defined. TODO: also add the available join fields on the type
data PartiallyResolvedRemoteRelationship remoteRelationshipDefinition = PartiallyResolvedRemoteRelationship
  { forall remoteRelationshipDefinition.
PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> Name
_prrrTypeName :: G.Name,
    forall remoteRelationshipDefinition.
PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> RemoteRelationshipG remoteRelationshipDefinition
_prrrDefinition :: RemoteRelationshipG remoteRelationshipDefinition
  }
  deriving (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> Bool
(PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
 -> PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
 -> Bool)
-> (PartiallyResolvedRemoteRelationship
      remoteRelationshipDefinition
    -> PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
    -> Bool)
-> Eq
     (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)
forall remoteRelationshipDefinition.
Eq remoteRelationshipDefinition =>
PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall remoteRelationshipDefinition.
Eq remoteRelationshipDefinition =>
PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> Bool
== :: PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> Bool
$c/= :: forall remoteRelationshipDefinition.
Eq remoteRelationshipDefinition =>
PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> Bool
/= :: PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> Bool
Eq, (forall x.
 PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
 -> Rep
      (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)
      x)
-> (forall x.
    Rep
      (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)
      x
    -> PartiallyResolvedRemoteRelationship
         remoteRelationshipDefinition)
-> Generic
     (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)
forall x.
Rep
  (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)
  x
-> PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
forall x.
PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> Rep
     (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)
     x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall remoteRelationshipDefinition x.
Rep
  (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)
  x
-> PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
forall remoteRelationshipDefinition x.
PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> Rep
     (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)
     x
$cfrom :: forall remoteRelationshipDefinition x.
PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> Rep
     (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)
     x
from :: forall x.
PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> Rep
     (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)
     x
$cto :: forall remoteRelationshipDefinition x.
Rep
  (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)
  x
-> PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
to :: forall x.
Rep
  (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)
  x
-> PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
Generic)

-- | We can't go from RemoteSchemaMetadata to RemoteSchemaCtx in a single phase
-- because we don't have information to resolve remote relationships. So we
-- annotate remote relationships with as much information as we know about them
-- which would be further resolved in a later stage.
type PartiallyResolvedRemoteSchemaCtxG remoteRelationshipDefinition =
  RemoteSchemaCtxG (PartiallyResolvedRemoteRelationship remoteRelationshipDefinition)

-- | 'RemoteSchemaDef' after validation and baking-in of defaults in 'validateRemoteSchemaDef'.
data ValidatedRemoteSchemaDef = ValidatedRemoteSchemaDef
  { ValidatedRemoteSchemaDef -> EnvRecord URI
_vrsdUrl :: EnvRecord N.URI,
    ValidatedRemoteSchemaDef -> [HeaderConf]
_vrsdHeaders :: [HeaderConf],
    ValidatedRemoteSchemaDef -> Bool
_vrsdFwdClientHeaders :: Bool,
    ValidatedRemoteSchemaDef -> Int
_vrsdTimeoutSeconds :: Int,
    -- | See '_rsdCustomization'.
    ValidatedRemoteSchemaDef -> Maybe RemoteSchemaCustomization
_vrsdCustomization :: Maybe RemoteSchemaCustomization
  }
  deriving (Int -> ValidatedRemoteSchemaDef -> ShowS
[ValidatedRemoteSchemaDef] -> ShowS
ValidatedRemoteSchemaDef -> String
(Int -> ValidatedRemoteSchemaDef -> ShowS)
-> (ValidatedRemoteSchemaDef -> String)
-> ([ValidatedRemoteSchemaDef] -> ShowS)
-> Show ValidatedRemoteSchemaDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidatedRemoteSchemaDef -> ShowS
showsPrec :: Int -> ValidatedRemoteSchemaDef -> ShowS
$cshow :: ValidatedRemoteSchemaDef -> String
show :: ValidatedRemoteSchemaDef -> String
$cshowList :: [ValidatedRemoteSchemaDef] -> ShowS
showList :: [ValidatedRemoteSchemaDef] -> ShowS
Show, ValidatedRemoteSchemaDef -> ValidatedRemoteSchemaDef -> Bool
(ValidatedRemoteSchemaDef -> ValidatedRemoteSchemaDef -> Bool)
-> (ValidatedRemoteSchemaDef -> ValidatedRemoteSchemaDef -> Bool)
-> Eq ValidatedRemoteSchemaDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidatedRemoteSchemaDef -> ValidatedRemoteSchemaDef -> Bool
== :: ValidatedRemoteSchemaDef -> ValidatedRemoteSchemaDef -> Bool
$c/= :: ValidatedRemoteSchemaDef -> ValidatedRemoteSchemaDef -> Bool
/= :: ValidatedRemoteSchemaDef -> ValidatedRemoteSchemaDef -> Bool
Eq, (forall x.
 ValidatedRemoteSchemaDef -> Rep ValidatedRemoteSchemaDef x)
-> (forall x.
    Rep ValidatedRemoteSchemaDef x -> ValidatedRemoteSchemaDef)
-> Generic ValidatedRemoteSchemaDef
forall x.
Rep ValidatedRemoteSchemaDef x -> ValidatedRemoteSchemaDef
forall x.
ValidatedRemoteSchemaDef -> Rep ValidatedRemoteSchemaDef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ValidatedRemoteSchemaDef -> Rep ValidatedRemoteSchemaDef x
from :: forall x.
ValidatedRemoteSchemaDef -> Rep ValidatedRemoteSchemaDef x
$cto :: forall x.
Rep ValidatedRemoteSchemaDef x -> ValidatedRemoteSchemaDef
to :: forall x.
Rep ValidatedRemoteSchemaDef x -> ValidatedRemoteSchemaDef
Generic)

instance NFData ValidatedRemoteSchemaDef

instance Hashable ValidatedRemoteSchemaDef

data RemoteSchemaCustomizer = RemoteSchemaCustomizer
  { RemoteSchemaCustomizer -> Maybe Name
_rscNamespaceFieldName :: Maybe G.Name,
    -- | type name -> type name
    RemoteSchemaCustomizer -> HashMap Name Name
_rscCustomizeTypeName :: HashMap G.Name G.Name,
    -- | type name -> field name -> field name
    RemoteSchemaCustomizer -> HashMap Name (HashMap Name Name)
_rscCustomizeFieldName :: HashMap G.Name (HashMap G.Name G.Name)
  }
  deriving (Int -> RemoteSchemaCustomizer -> ShowS
[RemoteSchemaCustomizer] -> ShowS
RemoteSchemaCustomizer -> String
(Int -> RemoteSchemaCustomizer -> ShowS)
-> (RemoteSchemaCustomizer -> String)
-> ([RemoteSchemaCustomizer] -> ShowS)
-> Show RemoteSchemaCustomizer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteSchemaCustomizer -> ShowS
showsPrec :: Int -> RemoteSchemaCustomizer -> ShowS
$cshow :: RemoteSchemaCustomizer -> String
show :: RemoteSchemaCustomizer -> String
$cshowList :: [RemoteSchemaCustomizer] -> ShowS
showList :: [RemoteSchemaCustomizer] -> ShowS
Show, RemoteSchemaCustomizer -> RemoteSchemaCustomizer -> Bool
(RemoteSchemaCustomizer -> RemoteSchemaCustomizer -> Bool)
-> (RemoteSchemaCustomizer -> RemoteSchemaCustomizer -> Bool)
-> Eq RemoteSchemaCustomizer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteSchemaCustomizer -> RemoteSchemaCustomizer -> Bool
== :: RemoteSchemaCustomizer -> RemoteSchemaCustomizer -> Bool
$c/= :: RemoteSchemaCustomizer -> RemoteSchemaCustomizer -> Bool
/= :: RemoteSchemaCustomizer -> RemoteSchemaCustomizer -> Bool
Eq, (forall x. RemoteSchemaCustomizer -> Rep RemoteSchemaCustomizer x)
-> (forall x.
    Rep RemoteSchemaCustomizer x -> RemoteSchemaCustomizer)
-> Generic RemoteSchemaCustomizer
forall x. Rep RemoteSchemaCustomizer x -> RemoteSchemaCustomizer
forall x. RemoteSchemaCustomizer -> Rep RemoteSchemaCustomizer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteSchemaCustomizer -> Rep RemoteSchemaCustomizer x
from :: forall x. RemoteSchemaCustomizer -> Rep RemoteSchemaCustomizer x
$cto :: forall x. Rep RemoteSchemaCustomizer x -> RemoteSchemaCustomizer
to :: forall x. Rep RemoteSchemaCustomizer x -> RemoteSchemaCustomizer
Generic)

identityCustomizer :: RemoteSchemaCustomizer
identityCustomizer :: RemoteSchemaCustomizer
identityCustomizer = Maybe Name
-> HashMap Name Name
-> HashMap Name (HashMap Name Name)
-> RemoteSchemaCustomizer
RemoteSchemaCustomizer Maybe Name
forall a. Maybe a
Nothing HashMap Name Name
forall a. Monoid a => a
mempty HashMap Name (HashMap Name Name)
forall a. Monoid a => a
mempty

instance NFData RemoteSchemaCustomizer

instance Hashable RemoteSchemaCustomizer

remoteSchemaCustomizeTypeName :: RemoteSchemaCustomizer -> MkTypename
remoteSchemaCustomizeTypeName :: RemoteSchemaCustomizer -> MkTypename
remoteSchemaCustomizeTypeName RemoteSchemaCustomizer {Maybe Name
HashMap Name (HashMap Name Name)
HashMap Name Name
_rscNamespaceFieldName :: RemoteSchemaCustomizer -> Maybe Name
_rscCustomizeTypeName :: RemoteSchemaCustomizer -> HashMap Name Name
_rscCustomizeFieldName :: RemoteSchemaCustomizer -> HashMap Name (HashMap Name Name)
_rscNamespaceFieldName :: Maybe Name
_rscCustomizeTypeName :: HashMap Name Name
_rscCustomizeFieldName :: HashMap Name (HashMap Name Name)
..} = (Name -> Name) -> MkTypename
MkTypename ((Name -> Name) -> MkTypename) -> (Name -> Name) -> MkTypename
forall a b. (a -> b) -> a -> b
$ \Name
typeName ->
  Name -> Name -> HashMap Name Name -> Name
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.lookupDefault Name
typeName Name
typeName HashMap Name Name
_rscCustomizeTypeName

newtype CustomizeRemoteFieldName = CustomizeRemoteFieldName
  { CustomizeRemoteFieldName -> Name -> Name -> Name
runCustomizeRemoteFieldName :: G.Name -> G.Name -> G.Name
  }
  deriving (NonEmpty CustomizeRemoteFieldName -> CustomizeRemoteFieldName
CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
(CustomizeRemoteFieldName
 -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName)
-> (NonEmpty CustomizeRemoteFieldName -> CustomizeRemoteFieldName)
-> (forall b.
    Integral b =>
    b -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName)
-> Semigroup CustomizeRemoteFieldName
forall b.
Integral b =>
b -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
<> :: CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
$csconcat :: NonEmpty CustomizeRemoteFieldName -> CustomizeRemoteFieldName
sconcat :: NonEmpty CustomizeRemoteFieldName -> CustomizeRemoteFieldName
$cstimes :: forall b.
Integral b =>
b -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
stimes :: forall b.
Integral b =>
b -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
Semigroup, Semigroup CustomizeRemoteFieldName
CustomizeRemoteFieldName
Semigroup CustomizeRemoteFieldName
-> CustomizeRemoteFieldName
-> (CustomizeRemoteFieldName
    -> CustomizeRemoteFieldName -> CustomizeRemoteFieldName)
-> ([CustomizeRemoteFieldName] -> CustomizeRemoteFieldName)
-> Monoid CustomizeRemoteFieldName
[CustomizeRemoteFieldName] -> CustomizeRemoteFieldName
CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: CustomizeRemoteFieldName
mempty :: CustomizeRemoteFieldName
$cmappend :: CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
mappend :: CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> CustomizeRemoteFieldName
$cmconcat :: [CustomizeRemoteFieldName] -> CustomizeRemoteFieldName
mconcat :: [CustomizeRemoteFieldName] -> CustomizeRemoteFieldName
Monoid) via (G.Name -> Endo G.Name)

withRemoteFieldNameCustomization :: forall m r a. (MonadReader r m, Has CustomizeRemoteFieldName r) => CustomizeRemoteFieldName -> m a -> m a
withRemoteFieldNameCustomization :: forall (m :: * -> *) r a.
(MonadReader r m, Has CustomizeRemoteFieldName r) =>
CustomizeRemoteFieldName -> m a -> m a
withRemoteFieldNameCustomization = (r -> r) -> m a -> m a
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((r -> r) -> m a -> m a)
-> (CustomizeRemoteFieldName -> r -> r)
-> CustomizeRemoteFieldName
-> m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter r r CustomizeRemoteFieldName CustomizeRemoteFieldName
-> CustomizeRemoteFieldName -> r -> r
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter r r CustomizeRemoteFieldName CustomizeRemoteFieldName
forall a t. Has a t => Lens t a
Lens r CustomizeRemoteFieldName
hasLens

remoteSchemaCustomizeFieldName :: RemoteSchemaCustomizer -> CustomizeRemoteFieldName
remoteSchemaCustomizeFieldName :: RemoteSchemaCustomizer -> CustomizeRemoteFieldName
remoteSchemaCustomizeFieldName RemoteSchemaCustomizer {Maybe Name
HashMap Name (HashMap Name Name)
HashMap Name Name
_rscNamespaceFieldName :: RemoteSchemaCustomizer -> Maybe Name
_rscCustomizeTypeName :: RemoteSchemaCustomizer -> HashMap Name Name
_rscCustomizeFieldName :: RemoteSchemaCustomizer -> HashMap Name (HashMap Name Name)
_rscNamespaceFieldName :: Maybe Name
_rscCustomizeTypeName :: HashMap Name Name
_rscCustomizeFieldName :: HashMap Name (HashMap Name Name)
..} = (Name -> Name -> Name) -> CustomizeRemoteFieldName
CustomizeRemoteFieldName ((Name -> Name -> Name) -> CustomizeRemoteFieldName)
-> (Name -> Name -> Name) -> CustomizeRemoteFieldName
forall a b. (a -> b) -> a -> b
$ \Name
typeName Name
fieldName ->
  Name
-> HashMap Name (HashMap Name Name) -> Maybe (HashMap Name Name)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
typeName HashMap Name (HashMap Name Name)
_rscCustomizeFieldName Maybe (HashMap Name Name)
-> (HashMap Name Name -> Maybe Name) -> Maybe Name
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> HashMap Name Name -> Maybe Name
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
fieldName Maybe Name -> (Maybe Name -> Name) -> Name
forall a b. a -> (a -> b) -> b
& Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe Name
fieldName

hasTypeOrFieldCustomizations :: RemoteSchemaCustomizer -> Bool
hasTypeOrFieldCustomizations :: RemoteSchemaCustomizer -> Bool
hasTypeOrFieldCustomizations RemoteSchemaCustomizer {Maybe Name
HashMap Name (HashMap Name Name)
HashMap Name Name
_rscNamespaceFieldName :: RemoteSchemaCustomizer -> Maybe Name
_rscCustomizeTypeName :: RemoteSchemaCustomizer -> HashMap Name Name
_rscCustomizeFieldName :: RemoteSchemaCustomizer -> HashMap Name (HashMap Name Name)
_rscNamespaceFieldName :: Maybe Name
_rscCustomizeTypeName :: HashMap Name Name
_rscCustomizeFieldName :: HashMap Name (HashMap Name Name)
..} =
  Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HashMap Name Name -> Bool
forall k v. HashMap k v -> Bool
HashMap.null HashMap Name Name
_rscCustomizeTypeName Bool -> Bool -> Bool
&& HashMap Name (HashMap Name Name) -> Bool
forall k v. HashMap k v -> Bool
HashMap.null HashMap Name (HashMap Name Name)
_rscCustomizeFieldName

-- | 'RemoteSchemaDef' after the RemoteSchemaCustomizer has been generated
-- by fetchRemoteSchema
data RemoteSchemaInfo = RemoteSchemaInfo
  { RemoteSchemaInfo -> ValidatedRemoteSchemaDef
rsDef :: ValidatedRemoteSchemaDef,
    RemoteSchemaInfo -> RemoteSchemaCustomizer
rsCustomizer :: RemoteSchemaCustomizer
  }
  deriving (Int -> RemoteSchemaInfo -> ShowS
[RemoteSchemaInfo] -> ShowS
RemoteSchemaInfo -> String
(Int -> RemoteSchemaInfo -> ShowS)
-> (RemoteSchemaInfo -> String)
-> ([RemoteSchemaInfo] -> ShowS)
-> Show RemoteSchemaInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteSchemaInfo -> ShowS
showsPrec :: Int -> RemoteSchemaInfo -> ShowS
$cshow :: RemoteSchemaInfo -> String
show :: RemoteSchemaInfo -> String
$cshowList :: [RemoteSchemaInfo] -> ShowS
showList :: [RemoteSchemaInfo] -> ShowS
Show, RemoteSchemaInfo -> RemoteSchemaInfo -> Bool
(RemoteSchemaInfo -> RemoteSchemaInfo -> Bool)
-> (RemoteSchemaInfo -> RemoteSchemaInfo -> Bool)
-> Eq RemoteSchemaInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteSchemaInfo -> RemoteSchemaInfo -> Bool
== :: RemoteSchemaInfo -> RemoteSchemaInfo -> Bool
$c/= :: RemoteSchemaInfo -> RemoteSchemaInfo -> Bool
/= :: RemoteSchemaInfo -> RemoteSchemaInfo -> Bool
Eq, (forall x. RemoteSchemaInfo -> Rep RemoteSchemaInfo x)
-> (forall x. Rep RemoteSchemaInfo x -> RemoteSchemaInfo)
-> Generic RemoteSchemaInfo
forall x. Rep RemoteSchemaInfo x -> RemoteSchemaInfo
forall x. RemoteSchemaInfo -> Rep RemoteSchemaInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteSchemaInfo -> Rep RemoteSchemaInfo x
from :: forall x. RemoteSchemaInfo -> Rep RemoteSchemaInfo x
$cto :: forall x. Rep RemoteSchemaInfo x -> RemoteSchemaInfo
to :: forall x. Rep RemoteSchemaInfo x -> RemoteSchemaInfo
Generic)

instance NFData RemoteSchemaInfo

instance Hashable RemoteSchemaInfo

validateRemoteSchemaCustomization ::
  (MonadError QErr m) =>
  Maybe RemoteSchemaCustomization ->
  m ()
validateRemoteSchemaCustomization :: forall (m :: * -> *).
MonadError QErr m =>
Maybe RemoteSchemaCustomization -> m ()
validateRemoteSchemaCustomization Maybe RemoteSchemaCustomization
Nothing = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
validateRemoteSchemaCustomization (Just RemoteSchemaCustomization {Maybe [RemoteFieldCustomization]
Maybe Name
Maybe RemoteTypeCustomization
_rscRootFieldsNamespace :: Maybe Name
_rscTypeNames :: Maybe RemoteTypeCustomization
_rscFieldNames :: Maybe [RemoteFieldCustomization]
_rscRootFieldsNamespace :: RemoteSchemaCustomization -> Maybe Name
_rscTypeNames :: RemoteSchemaCustomization -> Maybe RemoteTypeCustomization
_rscFieldNames :: RemoteSchemaCustomization -> Maybe [RemoteFieldCustomization]
..}) =
  Maybe [RemoteFieldCustomization]
-> ([RemoteFieldCustomization] -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe [RemoteFieldCustomization]
_rscFieldNames (([RemoteFieldCustomization] -> m ()) -> m ())
-> ([RemoteFieldCustomization] -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \[RemoteFieldCustomization]
fieldCustomizations ->
    [RemoteFieldCustomization]
-> (RemoteFieldCustomization -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [RemoteFieldCustomization]
fieldCustomizations ((RemoteFieldCustomization -> m ()) -> m ())
-> (RemoteFieldCustomization -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \RemoteFieldCustomization {Maybe Name
HashMap Name Name
Name
_rfcParentType :: Name
_rfcPrefix :: Maybe Name
_rfcSuffix :: Maybe Name
_rfcMapping :: HashMap Name Name
_rfcParentType :: RemoteFieldCustomization -> Name
_rfcPrefix :: RemoteFieldCustomization -> Maybe Name
_rfcSuffix :: RemoteFieldCustomization -> Maybe Name
_rfcMapping :: RemoteFieldCustomization -> HashMap Name Name
..} ->
      [Name] -> (Name -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (HashMap Name Name -> [Name]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Name Name
_rfcMapping) ((Name -> m ()) -> m ()) -> (Name -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Name
fieldName ->
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> Bool
isReservedName Name
fieldName)
          (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidParams
          (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"attempt to customize reserved field name "
          Text -> Name -> Text
forall t. ToTxt t => Text -> t -> Text
<>> Name
fieldName
  where
    isReservedName :: Name -> Bool
isReservedName = (Text
"__" Text -> Text -> Bool
`T.isPrefixOf`) (Text -> Bool) -> (Name -> Text) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
G.unName

validateRemoteSchemaDef ::
  (MonadError QErr m) =>
  Env.Environment ->
  RemoteSchemaDef ->
  m ValidatedRemoteSchemaDef
validateRemoteSchemaDef :: forall (m :: * -> *).
MonadError QErr m =>
Environment -> RemoteSchemaDef -> m ValidatedRemoteSchemaDef
validateRemoteSchemaDef Environment
env (RemoteSchemaDef Maybe InputWebhook
mUrl Maybe Text
mUrlEnv Maybe [HeaderConf]
hdrC Bool
fwdHdrs Maybe Int
mTimeout Maybe RemoteSchemaCustomization
customization) = do
  Maybe RemoteSchemaCustomization -> m ()
forall (m :: * -> *).
MonadError QErr m =>
Maybe RemoteSchemaCustomization -> m ()
validateRemoteSchemaCustomization Maybe RemoteSchemaCustomization
customization
  case (Maybe InputWebhook
mUrl, Maybe Text
mUrlEnv) of
    -- case 1: URL is supplied as a template
    (Just InputWebhook
url, Maybe Text
Nothing) -> do
      Text
resolvedWebhookTxt <- ResolvedWebhook -> Text
unResolvedWebhook (ResolvedWebhook -> Text) -> m ResolvedWebhook -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Environment -> InputWebhook -> m ResolvedWebhook
forall (m :: * -> *).
QErrM m =>
Environment -> InputWebhook -> m ResolvedWebhook
resolveWebhook Environment
env InputWebhook
url
      case String -> Maybe URI
N.parseURI (String -> Maybe URI) -> String -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
resolvedWebhookTxt of
        Maybe URI
Nothing -> Code -> Text -> m ValidatedRemoteSchemaDef
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidParams (Text -> m ValidatedRemoteSchemaDef)
-> Text -> m ValidatedRemoteSchemaDef
forall a b. (a -> b) -> a -> b
$ Text
"not a valid URI generated from the template: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> InputWebhook -> Text
getTemplateFromUrl InputWebhook
url
        Just URI
uri -> ValidatedRemoteSchemaDef -> m ValidatedRemoteSchemaDef
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ValidatedRemoteSchemaDef -> m ValidatedRemoteSchemaDef)
-> ValidatedRemoteSchemaDef -> m ValidatedRemoteSchemaDef
forall a b. (a -> b) -> a -> b
$ EnvRecord URI
-> [HeaderConf]
-> Bool
-> Int
-> Maybe RemoteSchemaCustomization
-> ValidatedRemoteSchemaDef
ValidatedRemoteSchemaDef (Text -> URI -> EnvRecord URI
forall a. Text -> a -> EnvRecord a
EnvRecord (InputWebhook -> Text
getTemplateFromUrl InputWebhook
url) URI
uri) [HeaderConf]
hdrs Bool
fwdHdrs Int
timeout Maybe RemoteSchemaCustomization
customization
    -- case 2: URL is supplied as an environment variable
    (Maybe InputWebhook
Nothing, Just Text
urlEnv) -> do
      EnvRecord URI
urlEnv' <- Environment -> Text -> m (EnvRecord URI)
forall (m :: * -> *).
MonadError QErr m =>
Environment -> Text -> m (EnvRecord URI)
getUrlFromEnv Environment
env Text
urlEnv
      ValidatedRemoteSchemaDef -> m ValidatedRemoteSchemaDef
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ValidatedRemoteSchemaDef -> m ValidatedRemoteSchemaDef)
-> ValidatedRemoteSchemaDef -> m ValidatedRemoteSchemaDef
forall a b. (a -> b) -> a -> b
$ EnvRecord URI
-> [HeaderConf]
-> Bool
-> Int
-> Maybe RemoteSchemaCustomization
-> ValidatedRemoteSchemaDef
ValidatedRemoteSchemaDef EnvRecord URI
urlEnv' [HeaderConf]
hdrs Bool
fwdHdrs Int
timeout Maybe RemoteSchemaCustomization
customization
    -- case 3: No url is supplied, throws an error 400
    (Maybe InputWebhook
Nothing, Maybe Text
Nothing) ->
      Code -> Text -> m ValidatedRemoteSchemaDef
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidParams Text
"both `url` and `url_from_env` can't be empty"
    -- case 4: Both template and environment variables are supplied, throws an error 400
    (Just InputWebhook
_, Just Text
_) ->
      Code -> Text -> m ValidatedRemoteSchemaDef
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidParams Text
"both `url` and `url_from_env` can't be present"
  where
    hdrs :: [HeaderConf]
hdrs = [HeaderConf] -> Maybe [HeaderConf] -> [HeaderConf]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [HeaderConf]
hdrC
    timeout :: Int
timeout = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
60 Maybe Int
mTimeout
    getTemplateFromUrl :: InputWebhook -> Text
getTemplateFromUrl InputWebhook
url = Template -> Text
printTemplate (Template -> Text) -> Template -> Text
forall a b. (a -> b) -> a -> b
$ InputWebhook -> Template
unInputWebhook InputWebhook
url

-- | See `resolveRemoteVariable` function. This data type is used
--   for validation of the session variable value
data SessionArgumentPresetInfo
  = SessionArgumentPresetScalar
  | SessionArgumentPresetEnum (Set.HashSet G.EnumValue)
  deriving (Int -> SessionArgumentPresetInfo -> ShowS
[SessionArgumentPresetInfo] -> ShowS
SessionArgumentPresetInfo -> String
(Int -> SessionArgumentPresetInfo -> ShowS)
-> (SessionArgumentPresetInfo -> String)
-> ([SessionArgumentPresetInfo] -> ShowS)
-> Show SessionArgumentPresetInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SessionArgumentPresetInfo -> ShowS
showsPrec :: Int -> SessionArgumentPresetInfo -> ShowS
$cshow :: SessionArgumentPresetInfo -> String
show :: SessionArgumentPresetInfo -> String
$cshowList :: [SessionArgumentPresetInfo] -> ShowS
showList :: [SessionArgumentPresetInfo] -> ShowS
Show, SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
(SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool)
-> (SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool)
-> Eq SessionArgumentPresetInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
== :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
$c/= :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
/= :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
Eq, (forall x.
 SessionArgumentPresetInfo -> Rep SessionArgumentPresetInfo x)
-> (forall x.
    Rep SessionArgumentPresetInfo x -> SessionArgumentPresetInfo)
-> Generic SessionArgumentPresetInfo
forall x.
Rep SessionArgumentPresetInfo x -> SessionArgumentPresetInfo
forall x.
SessionArgumentPresetInfo -> Rep SessionArgumentPresetInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SessionArgumentPresetInfo -> Rep SessionArgumentPresetInfo x
from :: forall x.
SessionArgumentPresetInfo -> Rep SessionArgumentPresetInfo x
$cto :: forall x.
Rep SessionArgumentPresetInfo x -> SessionArgumentPresetInfo
to :: forall x.
Rep SessionArgumentPresetInfo x -> SessionArgumentPresetInfo
Generic, Eq SessionArgumentPresetInfo
Eq SessionArgumentPresetInfo
-> (SessionArgumentPresetInfo
    -> SessionArgumentPresetInfo -> Ordering)
-> (SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool)
-> (SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool)
-> (SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool)
-> (SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool)
-> (SessionArgumentPresetInfo
    -> SessionArgumentPresetInfo -> SessionArgumentPresetInfo)
-> (SessionArgumentPresetInfo
    -> SessionArgumentPresetInfo -> SessionArgumentPresetInfo)
-> Ord SessionArgumentPresetInfo
SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Ordering
SessionArgumentPresetInfo
-> SessionArgumentPresetInfo -> SessionArgumentPresetInfo
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 :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Ordering
compare :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Ordering
$c< :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
< :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
$c<= :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
<= :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
$c> :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
> :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
$c>= :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
>= :: SessionArgumentPresetInfo -> SessionArgumentPresetInfo -> Bool
$cmax :: SessionArgumentPresetInfo
-> SessionArgumentPresetInfo -> SessionArgumentPresetInfo
max :: SessionArgumentPresetInfo
-> SessionArgumentPresetInfo -> SessionArgumentPresetInfo
$cmin :: SessionArgumentPresetInfo
-> SessionArgumentPresetInfo -> SessionArgumentPresetInfo
min :: SessionArgumentPresetInfo
-> SessionArgumentPresetInfo -> SessionArgumentPresetInfo
Ord)

instance Hashable SessionArgumentPresetInfo

-- | Details required to resolve a "session variable preset" variable.
--
-- See Notes [Remote Schema Argument Presets] and [Remote Schema Permissions
-- Architecture] for additional information.
data RemoteSchemaVariable
  = SessionPresetVariable SessionVariable G.Name SessionArgumentPresetInfo
  | QueryVariable Variable
  | RemoteJSONValue G.GType J.Value
  deriving (Int -> RemoteSchemaVariable -> ShowS
[RemoteSchemaVariable] -> ShowS
RemoteSchemaVariable -> String
(Int -> RemoteSchemaVariable -> ShowS)
-> (RemoteSchemaVariable -> String)
-> ([RemoteSchemaVariable] -> ShowS)
-> Show RemoteSchemaVariable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteSchemaVariable -> ShowS
showsPrec :: Int -> RemoteSchemaVariable -> ShowS
$cshow :: RemoteSchemaVariable -> String
show :: RemoteSchemaVariable -> String
$cshowList :: [RemoteSchemaVariable] -> ShowS
showList :: [RemoteSchemaVariable] -> ShowS
Show, RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
(RemoteSchemaVariable -> RemoteSchemaVariable -> Bool)
-> (RemoteSchemaVariable -> RemoteSchemaVariable -> Bool)
-> Eq RemoteSchemaVariable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
== :: RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
$c/= :: RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
/= :: RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
Eq, (forall x. RemoteSchemaVariable -> Rep RemoteSchemaVariable x)
-> (forall x. Rep RemoteSchemaVariable x -> RemoteSchemaVariable)
-> Generic RemoteSchemaVariable
forall x. Rep RemoteSchemaVariable x -> RemoteSchemaVariable
forall x. RemoteSchemaVariable -> Rep RemoteSchemaVariable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteSchemaVariable -> Rep RemoteSchemaVariable x
from :: forall x. RemoteSchemaVariable -> Rep RemoteSchemaVariable x
$cto :: forall x. Rep RemoteSchemaVariable x -> RemoteSchemaVariable
to :: forall x. Rep RemoteSchemaVariable x -> RemoteSchemaVariable
Generic, Eq RemoteSchemaVariable
Eq RemoteSchemaVariable
-> (RemoteSchemaVariable -> RemoteSchemaVariable -> Ordering)
-> (RemoteSchemaVariable -> RemoteSchemaVariable -> Bool)
-> (RemoteSchemaVariable -> RemoteSchemaVariable -> Bool)
-> (RemoteSchemaVariable -> RemoteSchemaVariable -> Bool)
-> (RemoteSchemaVariable -> RemoteSchemaVariable -> Bool)
-> (RemoteSchemaVariable
    -> RemoteSchemaVariable -> RemoteSchemaVariable)
-> (RemoteSchemaVariable
    -> RemoteSchemaVariable -> RemoteSchemaVariable)
-> Ord RemoteSchemaVariable
RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
RemoteSchemaVariable -> RemoteSchemaVariable -> Ordering
RemoteSchemaVariable
-> RemoteSchemaVariable -> RemoteSchemaVariable
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 :: RemoteSchemaVariable -> RemoteSchemaVariable -> Ordering
compare :: RemoteSchemaVariable -> RemoteSchemaVariable -> Ordering
$c< :: RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
< :: RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
$c<= :: RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
<= :: RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
$c> :: RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
> :: RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
$c>= :: RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
>= :: RemoteSchemaVariable -> RemoteSchemaVariable -> Bool
$cmax :: RemoteSchemaVariable
-> RemoteSchemaVariable -> RemoteSchemaVariable
max :: RemoteSchemaVariable
-> RemoteSchemaVariable -> RemoteSchemaVariable
$cmin :: RemoteSchemaVariable
-> RemoteSchemaVariable -> RemoteSchemaVariable
min :: RemoteSchemaVariable
-> RemoteSchemaVariable -> RemoteSchemaVariable
Ord)

instance Hashable RemoteSchemaVariable

-- | Extends 'G.InputValueDefinition' with an optional preset argument.
--
-- See Note [Remote Schema Argument Presets] for additional information.
data RemoteSchemaInputValueDefinition = RemoteSchemaInputValueDefinition
  { RemoteSchemaInputValueDefinition -> InputValueDefinition
_rsitdDefinition :: G.InputValueDefinition,
    RemoteSchemaInputValueDefinition
-> Maybe (Value RemoteSchemaVariable)
_rsitdPresetArgument :: Maybe (G.Value RemoteSchemaVariable)
  }
  deriving (Int -> RemoteSchemaInputValueDefinition -> ShowS
[RemoteSchemaInputValueDefinition] -> ShowS
RemoteSchemaInputValueDefinition -> String
(Int -> RemoteSchemaInputValueDefinition -> ShowS)
-> (RemoteSchemaInputValueDefinition -> String)
-> ([RemoteSchemaInputValueDefinition] -> ShowS)
-> Show RemoteSchemaInputValueDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteSchemaInputValueDefinition -> ShowS
showsPrec :: Int -> RemoteSchemaInputValueDefinition -> ShowS
$cshow :: RemoteSchemaInputValueDefinition -> String
show :: RemoteSchemaInputValueDefinition -> String
$cshowList :: [RemoteSchemaInputValueDefinition] -> ShowS
showList :: [RemoteSchemaInputValueDefinition] -> ShowS
Show, RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
(RemoteSchemaInputValueDefinition
 -> RemoteSchemaInputValueDefinition -> Bool)
-> (RemoteSchemaInputValueDefinition
    -> RemoteSchemaInputValueDefinition -> Bool)
-> Eq RemoteSchemaInputValueDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
== :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
$c/= :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
/= :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
Eq, (forall x.
 RemoteSchemaInputValueDefinition
 -> Rep RemoteSchemaInputValueDefinition x)
-> (forall x.
    Rep RemoteSchemaInputValueDefinition x
    -> RemoteSchemaInputValueDefinition)
-> Generic RemoteSchemaInputValueDefinition
forall x.
Rep RemoteSchemaInputValueDefinition x
-> RemoteSchemaInputValueDefinition
forall x.
RemoteSchemaInputValueDefinition
-> Rep RemoteSchemaInputValueDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RemoteSchemaInputValueDefinition
-> Rep RemoteSchemaInputValueDefinition x
from :: forall x.
RemoteSchemaInputValueDefinition
-> Rep RemoteSchemaInputValueDefinition x
$cto :: forall x.
Rep RemoteSchemaInputValueDefinition x
-> RemoteSchemaInputValueDefinition
to :: forall x.
Rep RemoteSchemaInputValueDefinition x
-> RemoteSchemaInputValueDefinition
Generic, Eq RemoteSchemaInputValueDefinition
Eq RemoteSchemaInputValueDefinition
-> (RemoteSchemaInputValueDefinition
    -> RemoteSchemaInputValueDefinition -> Ordering)
-> (RemoteSchemaInputValueDefinition
    -> RemoteSchemaInputValueDefinition -> Bool)
-> (RemoteSchemaInputValueDefinition
    -> RemoteSchemaInputValueDefinition -> Bool)
-> (RemoteSchemaInputValueDefinition
    -> RemoteSchemaInputValueDefinition -> Bool)
-> (RemoteSchemaInputValueDefinition
    -> RemoteSchemaInputValueDefinition -> Bool)
-> (RemoteSchemaInputValueDefinition
    -> RemoteSchemaInputValueDefinition
    -> RemoteSchemaInputValueDefinition)
-> (RemoteSchemaInputValueDefinition
    -> RemoteSchemaInputValueDefinition
    -> RemoteSchemaInputValueDefinition)
-> Ord RemoteSchemaInputValueDefinition
RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Ordering
RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition
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 :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Ordering
compare :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Ordering
$c< :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
< :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
$c<= :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
<= :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
$c> :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
> :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
$c>= :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
>= :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition -> Bool
$cmax :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition
max :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition
$cmin :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition
min :: RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition
-> RemoteSchemaInputValueDefinition
Ord)

instance Hashable RemoteSchemaInputValueDefinition

newtype RemoteSchemaIntrospection
  = RemoteSchemaIntrospection (HashMap G.Name (G.TypeDefinition [G.Name] RemoteSchemaInputValueDefinition))
  deriving (Int -> RemoteSchemaIntrospection -> ShowS
[RemoteSchemaIntrospection] -> ShowS
RemoteSchemaIntrospection -> String
(Int -> RemoteSchemaIntrospection -> ShowS)
-> (RemoteSchemaIntrospection -> String)
-> ([RemoteSchemaIntrospection] -> ShowS)
-> Show RemoteSchemaIntrospection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteSchemaIntrospection -> ShowS
showsPrec :: Int -> RemoteSchemaIntrospection -> ShowS
$cshow :: RemoteSchemaIntrospection -> String
show :: RemoteSchemaIntrospection -> String
$cshowList :: [RemoteSchemaIntrospection] -> ShowS
showList :: [RemoteSchemaIntrospection] -> ShowS
Show, RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
(RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool)
-> (RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool)
-> Eq RemoteSchemaIntrospection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
== :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
$c/= :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
/= :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
Eq, (forall x.
 RemoteSchemaIntrospection -> Rep RemoteSchemaIntrospection x)
-> (forall x.
    Rep RemoteSchemaIntrospection x -> RemoteSchemaIntrospection)
-> Generic RemoteSchemaIntrospection
forall x.
Rep RemoteSchemaIntrospection x -> RemoteSchemaIntrospection
forall x.
RemoteSchemaIntrospection -> Rep RemoteSchemaIntrospection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RemoteSchemaIntrospection -> Rep RemoteSchemaIntrospection x
from :: forall x.
RemoteSchemaIntrospection -> Rep RemoteSchemaIntrospection x
$cto :: forall x.
Rep RemoteSchemaIntrospection x -> RemoteSchemaIntrospection
to :: forall x.
Rep RemoteSchemaIntrospection x -> RemoteSchemaIntrospection
Generic, Eq RemoteSchemaIntrospection
Eq RemoteSchemaIntrospection
-> (Int -> RemoteSchemaIntrospection -> Int)
-> (RemoteSchemaIntrospection -> Int)
-> Hashable RemoteSchemaIntrospection
Int -> RemoteSchemaIntrospection -> Int
RemoteSchemaIntrospection -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> RemoteSchemaIntrospection -> Int
hashWithSalt :: Int -> RemoteSchemaIntrospection -> Int
$chash :: RemoteSchemaIntrospection -> Int
hash :: RemoteSchemaIntrospection -> Int
Hashable, Eq RemoteSchemaIntrospection
Eq RemoteSchemaIntrospection
-> (RemoteSchemaIntrospection
    -> RemoteSchemaIntrospection -> Ordering)
-> (RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool)
-> (RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool)
-> (RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool)
-> (RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool)
-> (RemoteSchemaIntrospection
    -> RemoteSchemaIntrospection -> RemoteSchemaIntrospection)
-> (RemoteSchemaIntrospection
    -> RemoteSchemaIntrospection -> RemoteSchemaIntrospection)
-> Ord RemoteSchemaIntrospection
RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Ordering
RemoteSchemaIntrospection
-> RemoteSchemaIntrospection -> RemoteSchemaIntrospection
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 :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Ordering
compare :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Ordering
$c< :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
< :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
$c<= :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
<= :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
$c> :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
> :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
$c>= :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
>= :: RemoteSchemaIntrospection -> RemoteSchemaIntrospection -> Bool
$cmax :: RemoteSchemaIntrospection
-> RemoteSchemaIntrospection -> RemoteSchemaIntrospection
max :: RemoteSchemaIntrospection
-> RemoteSchemaIntrospection -> RemoteSchemaIntrospection
$cmin :: RemoteSchemaIntrospection
-> RemoteSchemaIntrospection -> RemoteSchemaIntrospection
min :: RemoteSchemaIntrospection
-> RemoteSchemaIntrospection -> RemoteSchemaIntrospection
Ord)

-- | Extracts the name of a given type from its definition.
-- TODO: move this to Language.GraphQL.Draft.Syntax.
getTypeName :: G.TypeDefinition possibleTypes inputType -> G.Name
getTypeName :: forall possibleTypes inputType.
TypeDefinition possibleTypes inputType -> Name
getTypeName = \case
  G.TypeDefinitionScalar ScalarTypeDefinition
t -> ScalarTypeDefinition -> Name
G._stdName ScalarTypeDefinition
t
  G.TypeDefinitionObject ObjectTypeDefinition inputType
t -> ObjectTypeDefinition inputType -> Name
forall inputType. ObjectTypeDefinition inputType -> Name
G._otdName ObjectTypeDefinition inputType
t
  G.TypeDefinitionInterface InterfaceTypeDefinition possibleTypes inputType
t -> InterfaceTypeDefinition possibleTypes inputType -> Name
forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> Name
G._itdName InterfaceTypeDefinition possibleTypes inputType
t
  G.TypeDefinitionUnion UnionTypeDefinition
t -> UnionTypeDefinition -> Name
G._utdName UnionTypeDefinition
t
  G.TypeDefinitionEnum EnumTypeDefinition
t -> EnumTypeDefinition -> Name
G._etdName EnumTypeDefinition
t
  G.TypeDefinitionInputObject InputObjectTypeDefinition inputType
t -> InputObjectTypeDefinition inputType -> Name
forall inputType. InputObjectTypeDefinition inputType -> Name
G._iotdName InputObjectTypeDefinition inputType
t

lookupType ::
  RemoteSchemaIntrospection ->
  G.Name ->
  Maybe (G.TypeDefinition [G.Name] RemoteSchemaInputValueDefinition)
lookupType :: RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType (RemoteSchemaIntrospection HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
types) Name
name = Name
-> HashMap
     Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
name HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
types

lookupObject ::
  RemoteSchemaIntrospection ->
  G.Name ->
  Maybe (G.ObjectTypeDefinition RemoteSchemaInputValueDefinition)
lookupObject :: RemoteSchemaIntrospection
-> Name
-> Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
lookupObject RemoteSchemaIntrospection
introspection Name
name =
  RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
introspection Name
name Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> (TypeDefinition [Name] RemoteSchemaInputValueDefinition
    -> Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    G.TypeDefinitionObject ObjectTypeDefinition RemoteSchemaInputValueDefinition
t | ObjectTypeDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. ObjectTypeDefinition inputType -> Name
G._otdName ObjectTypeDefinition RemoteSchemaInputValueDefinition
t Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> ObjectTypeDefinition RemoteSchemaInputValueDefinition
-> Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall a. a -> Maybe a
Just ObjectTypeDefinition RemoteSchemaInputValueDefinition
t
    -- if this happens, it means the schema is inconsistent: we expected to
    -- find an object with that name, but instead found something that wasn't
    -- an object; we might want to indicate this with a proper failure, so we
    -- can show better diagnostics to the user?
    -- This also applies to all following functions.
    -- See: https://github.com/hasura/graphql-engine-mono/issues/2991
    TypeDefinition [Name] RemoteSchemaInputValueDefinition
_ -> Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall a. Maybe a
Nothing

lookupInterface ::
  RemoteSchemaIntrospection ->
  G.Name ->
  Maybe (G.InterfaceTypeDefinition [G.Name] RemoteSchemaInputValueDefinition)
lookupInterface :: RemoteSchemaIntrospection
-> Name
-> Maybe
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupInterface RemoteSchemaIntrospection
introspection Name
name =
  RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
introspection Name
name Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> (TypeDefinition [Name] RemoteSchemaInputValueDefinition
    -> Maybe
         (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition))
-> Maybe
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    G.TypeDefinitionInterface InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
t | InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
-> Name
forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> Name
G._itdName InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
t Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
-> Maybe
     (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall a. a -> Maybe a
Just InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition
t
    TypeDefinition [Name] RemoteSchemaInputValueDefinition
_ -> Maybe
  (InterfaceTypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall a. Maybe a
Nothing

lookupScalar ::
  RemoteSchemaIntrospection ->
  G.Name ->
  Maybe G.ScalarTypeDefinition
lookupScalar :: RemoteSchemaIntrospection -> Name -> Maybe ScalarTypeDefinition
lookupScalar RemoteSchemaIntrospection
introspection Name
name =
  RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
introspection Name
name Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> (TypeDefinition [Name] RemoteSchemaInputValueDefinition
    -> Maybe ScalarTypeDefinition)
-> Maybe ScalarTypeDefinition
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    G.TypeDefinitionScalar ScalarTypeDefinition
t | ScalarTypeDefinition -> Name
G._stdName ScalarTypeDefinition
t Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> ScalarTypeDefinition -> Maybe ScalarTypeDefinition
forall a. a -> Maybe a
Just ScalarTypeDefinition
t
    TypeDefinition [Name] RemoteSchemaInputValueDefinition
_ -> Maybe ScalarTypeDefinition
forall a. Maybe a
Nothing

lookupUnion ::
  RemoteSchemaIntrospection ->
  G.Name ->
  Maybe G.UnionTypeDefinition
lookupUnion :: RemoteSchemaIntrospection -> Name -> Maybe UnionTypeDefinition
lookupUnion RemoteSchemaIntrospection
introspection Name
name =
  RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
introspection Name
name Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> (TypeDefinition [Name] RemoteSchemaInputValueDefinition
    -> Maybe UnionTypeDefinition)
-> Maybe UnionTypeDefinition
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    G.TypeDefinitionUnion UnionTypeDefinition
t | UnionTypeDefinition -> Name
G._utdName UnionTypeDefinition
t Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> UnionTypeDefinition -> Maybe UnionTypeDefinition
forall a. a -> Maybe a
Just UnionTypeDefinition
t
    TypeDefinition [Name] RemoteSchemaInputValueDefinition
_ -> Maybe UnionTypeDefinition
forall a. Maybe a
Nothing

lookupEnum ::
  RemoteSchemaIntrospection ->
  G.Name ->
  Maybe G.EnumTypeDefinition
lookupEnum :: RemoteSchemaIntrospection -> Name -> Maybe EnumTypeDefinition
lookupEnum RemoteSchemaIntrospection
introspection Name
name =
  RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
introspection Name
name Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> (TypeDefinition [Name] RemoteSchemaInputValueDefinition
    -> Maybe EnumTypeDefinition)
-> Maybe EnumTypeDefinition
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    G.TypeDefinitionEnum EnumTypeDefinition
t | EnumTypeDefinition -> Name
G._etdName EnumTypeDefinition
t Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> EnumTypeDefinition -> Maybe EnumTypeDefinition
forall a. a -> Maybe a
Just EnumTypeDefinition
t
    TypeDefinition [Name] RemoteSchemaInputValueDefinition
_ -> Maybe EnumTypeDefinition
forall a. Maybe a
Nothing

lookupInputObject ::
  RemoteSchemaIntrospection ->
  G.Name ->
  Maybe (G.InputObjectTypeDefinition RemoteSchemaInputValueDefinition)
lookupInputObject :: RemoteSchemaIntrospection
-> Name
-> Maybe
     (InputObjectTypeDefinition RemoteSchemaInputValueDefinition)
lookupInputObject RemoteSchemaIntrospection
introspection Name
name =
  RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
introspection Name
name Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> (TypeDefinition [Name] RemoteSchemaInputValueDefinition
    -> Maybe
         (InputObjectTypeDefinition RemoteSchemaInputValueDefinition))
-> Maybe
     (InputObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    G.TypeDefinitionInputObject InputObjectTypeDefinition RemoteSchemaInputValueDefinition
t | InputObjectTypeDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. InputObjectTypeDefinition inputType -> Name
G._iotdName InputObjectTypeDefinition RemoteSchemaInputValueDefinition
t Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> InputObjectTypeDefinition RemoteSchemaInputValueDefinition
-> Maybe
     (InputObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall a. a -> Maybe a
Just InputObjectTypeDefinition RemoteSchemaInputValueDefinition
t
    TypeDefinition [Name] RemoteSchemaInputValueDefinition
_ -> Maybe (InputObjectTypeDefinition RemoteSchemaInputValueDefinition)
forall a. Maybe a
Nothing

-- remote relationships

-- A textual identifier for an entity on which remote relationships can be
-- defined. This is used in error messages and type name generation for
-- arguments in remote relationship fields to remote schemas (See
-- RemoteRelationship.Validate)
newtype LHSIdentifier = LHSIdentifier {LHSIdentifier -> Text
getLHSIdentifier :: Text}
  deriving (Int -> LHSIdentifier -> ShowS
[LHSIdentifier] -> ShowS
LHSIdentifier -> String
(Int -> LHSIdentifier -> ShowS)
-> (LHSIdentifier -> String)
-> ([LHSIdentifier] -> ShowS)
-> Show LHSIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LHSIdentifier -> ShowS
showsPrec :: Int -> LHSIdentifier -> ShowS
$cshow :: LHSIdentifier -> String
show :: LHSIdentifier -> String
$cshowList :: [LHSIdentifier] -> ShowS
showList :: [LHSIdentifier] -> ShowS
Show, LHSIdentifier -> LHSIdentifier -> Bool
(LHSIdentifier -> LHSIdentifier -> Bool)
-> (LHSIdentifier -> LHSIdentifier -> Bool) -> Eq LHSIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LHSIdentifier -> LHSIdentifier -> Bool
== :: LHSIdentifier -> LHSIdentifier -> Bool
$c/= :: LHSIdentifier -> LHSIdentifier -> Bool
/= :: LHSIdentifier -> LHSIdentifier -> Bool
Eq, (forall x. LHSIdentifier -> Rep LHSIdentifier x)
-> (forall x. Rep LHSIdentifier x -> LHSIdentifier)
-> Generic LHSIdentifier
forall x. Rep LHSIdentifier x -> LHSIdentifier
forall x. LHSIdentifier -> Rep LHSIdentifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LHSIdentifier -> Rep LHSIdentifier x
from :: forall x. LHSIdentifier -> Rep LHSIdentifier x
$cto :: forall x. Rep LHSIdentifier x -> LHSIdentifier
to :: forall x. Rep LHSIdentifier x -> LHSIdentifier
Generic)

remoteSchemaToLHSIdentifier :: RemoteSchemaName -> LHSIdentifier
remoteSchemaToLHSIdentifier :: RemoteSchemaName -> LHSIdentifier
remoteSchemaToLHSIdentifier = Text -> LHSIdentifier
LHSIdentifier (Text -> LHSIdentifier)
-> (RemoteSchemaName -> Text) -> RemoteSchemaName -> LHSIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaName -> Text
forall a. ToTxt a => a -> Text
toTxt

-- | Generates a valid graphql name from an arbitrary LHS identifier.
-- This is done by replacing all unrecognized characters by '_'. This
-- function still returns a @Maybe@ value, in cases we can't adjust
-- the raw text (such as the case of empty identifiers).
lhsIdentifierToGraphQLName :: LHSIdentifier -> Maybe G.Name
lhsIdentifierToGraphQLName :: LHSIdentifier -> Maybe Name
lhsIdentifierToGraphQLName (LHSIdentifier Text
rawText) = Text -> Maybe Name
G.mkName (Text -> Maybe Name) -> Text -> Maybe Name
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> Text -> Text
T.map Char -> Char
adjust Text
rawText
  where
    adjust :: Char -> Char
adjust Char
c =
      if Char -> Bool
C.isAsciiUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
C.isAsciiLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
C.isDigit Char
c
        then Char
c
        else Char
'_'

-- | Schema cache information for a table field targeting a remote schema.
data RemoteSchemaFieldInfo = RemoteSchemaFieldInfo
  { -- | Field name to which we'll map the remote in hasura; this becomes part
    --   of the hasura schema.
    RemoteSchemaFieldInfo -> RelName
_rrfiName :: RelName,
    -- | Input arguments to the remote field info; The '_rfiParamMap' will only
    --   include the arguments to the remote field that is being joined. The
    --   names of the arguments here are modified, it will be in the format of
    --   <Original Field Name>_remote_rel_<hasura table schema>_<hasura table name><remote relationship name>
    RemoteSchemaFieldInfo
-> HashMap Name RemoteSchemaInputValueDefinition
_rrfiParamMap :: HashMap G.Name RemoteSchemaInputValueDefinition,
    RemoteSchemaFieldInfo -> RemoteFields
_rrfiRemoteFields :: RemoteFields,
    RemoteSchemaFieldInfo -> RemoteSchemaInfo
_rrfiRemoteSchema :: RemoteSchemaInfo,
    -- | The new input value definitions created for this remote field
    RemoteSchemaFieldInfo
-> [TypeDefinition [Name] RemoteSchemaInputValueDefinition]
_rrfiInputValueDefinitions :: [G.TypeDefinition [G.Name] RemoteSchemaInputValueDefinition],
    -- | Name of the remote schema, that's used for joining
    RemoteSchemaFieldInfo -> RemoteSchemaName
_rrfiRemoteSchemaName :: RemoteSchemaName,
    -- | TODO: this one should be gone when 'validateRemoteRelationship'
    -- function is cleaned up
    RemoteSchemaFieldInfo -> LHSIdentifier
_rrfiLHSIdentifier :: LHSIdentifier
  }
  deriving ((forall x. RemoteSchemaFieldInfo -> Rep RemoteSchemaFieldInfo x)
-> (forall x. Rep RemoteSchemaFieldInfo x -> RemoteSchemaFieldInfo)
-> Generic RemoteSchemaFieldInfo
forall x. Rep RemoteSchemaFieldInfo x -> RemoteSchemaFieldInfo
forall x. RemoteSchemaFieldInfo -> Rep RemoteSchemaFieldInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteSchemaFieldInfo -> Rep RemoteSchemaFieldInfo x
from :: forall x. RemoteSchemaFieldInfo -> Rep RemoteSchemaFieldInfo x
$cto :: forall x. Rep RemoteSchemaFieldInfo x -> RemoteSchemaFieldInfo
to :: forall x. Rep RemoteSchemaFieldInfo x -> RemoteSchemaFieldInfo
Generic, RemoteSchemaFieldInfo -> RemoteSchemaFieldInfo -> Bool
(RemoteSchemaFieldInfo -> RemoteSchemaFieldInfo -> Bool)
-> (RemoteSchemaFieldInfo -> RemoteSchemaFieldInfo -> Bool)
-> Eq RemoteSchemaFieldInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteSchemaFieldInfo -> RemoteSchemaFieldInfo -> Bool
== :: RemoteSchemaFieldInfo -> RemoteSchemaFieldInfo -> Bool
$c/= :: RemoteSchemaFieldInfo -> RemoteSchemaFieldInfo -> Bool
/= :: RemoteSchemaFieldInfo -> RemoteSchemaFieldInfo -> Bool
Eq, Int -> RemoteSchemaFieldInfo -> ShowS
[RemoteSchemaFieldInfo] -> ShowS
RemoteSchemaFieldInfo -> String
(Int -> RemoteSchemaFieldInfo -> ShowS)
-> (RemoteSchemaFieldInfo -> String)
-> ([RemoteSchemaFieldInfo] -> ShowS)
-> Show RemoteSchemaFieldInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteSchemaFieldInfo -> ShowS
showsPrec :: Int -> RemoteSchemaFieldInfo -> ShowS
$cshow :: RemoteSchemaFieldInfo -> String
show :: RemoteSchemaFieldInfo -> String
$cshowList :: [RemoteSchemaFieldInfo] -> ShowS
showList :: [RemoteSchemaFieldInfo] -> ShowS
Show)

-- FIXME: deduplicate this
graphQLValueToJSON :: G.Value Void -> J.Value
graphQLValueToJSON :: Value Void -> Value
graphQLValueToJSON = \case
  Value Void
G.VNull -> Value
J.Null
  G.VInt Integer
i -> Integer -> Value
forall a. ToJSON a => a -> Value
J.toJSON Integer
i
  G.VFloat Scientific
f -> Scientific -> Value
forall a. ToJSON a => a -> Value
J.toJSON Scientific
f
  G.VString Text
t -> Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON Text
t
  G.VBoolean Bool
b -> Bool -> Value
forall a. ToJSON a => a -> Value
J.toJSON Bool
b
  G.VEnum (G.EnumValue Name
n) -> Name -> Value
forall a. ToJSON a => a -> Value
J.toJSON Name
n
  G.VList [Value Void]
values -> [Value] -> Value
forall a. ToJSON a => a -> Value
J.toJSON ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ Value Void -> Value
graphQLValueToJSON (Value Void -> Value) -> [Value Void] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value Void]
values
  G.VObject HashMap Name (Value Void)
objects -> HashMap Name Value -> Value
forall a. ToJSON a => a -> Value
J.toJSON (HashMap Name Value -> Value) -> HashMap Name Value -> Value
forall a b. (a -> b) -> a -> b
$ Value Void -> Value
graphQLValueToJSON (Value Void -> Value)
-> HashMap Name (Value Void) -> HashMap Name Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Name (Value Void)
objects

$(J.deriveJSON hasuraJSON ''ValidatedRemoteSchemaDef)
$(J.deriveJSON hasuraJSON ''RemoteSchemaCustomizer)
$(J.deriveJSON hasuraJSON ''RemoteSchemaInfo)

instance (J.ToJSON remoteFieldInfo) => J.ToJSON (RemoteSchemaCtxG remoteFieldInfo) where
  toJSON :: RemoteSchemaCtxG remoteFieldInfo -> Value
toJSON RemoteSchemaCtx {HashMap RoleName IntrospectionResult
ByteString
RemoteSchemaRelationshipsG remoteFieldInfo
RemoteSchemaName
RemoteSchemaInfo
IntrospectionResult
_rscName :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> RemoteSchemaName
_rscIntroOriginal :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> IntrospectionResult
_rscInfo :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> RemoteSchemaInfo
_rscRawIntrospectionResult :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> ByteString
_rscPermissions :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo
-> HashMap RoleName IntrospectionResult
_rscRemoteRelationships :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo
-> RemoteSchemaRelationshipsG remoteFieldInfo
_rscName :: RemoteSchemaName
_rscIntroOriginal :: IntrospectionResult
_rscInfo :: RemoteSchemaInfo
_rscRawIntrospectionResult :: ByteString
_rscPermissions :: HashMap RoleName IntrospectionResult
_rscRemoteRelationships :: RemoteSchemaRelationshipsG remoteFieldInfo
..} =
    [Pair] -> Value
J.object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Key
"name" Key -> RemoteSchemaName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= RemoteSchemaName
_rscName,
          Key
"info" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= RemoteSchemaInfo -> Value
forall a. ToJSON a => a -> Value
J.toJSON RemoteSchemaInfo
_rscInfo
        ]

instance J.ToJSON RemoteSchemaFieldInfo where
  toJSON :: RemoteSchemaFieldInfo -> Value
toJSON RemoteSchemaFieldInfo {[TypeDefinition [Name] RemoteSchemaInputValueDefinition]
HashMap Name RemoteSchemaInputValueDefinition
RelName
RemoteSchemaName
RemoteFields
LHSIdentifier
RemoteSchemaInfo
_rrfiName :: RemoteSchemaFieldInfo -> RelName
_rrfiParamMap :: RemoteSchemaFieldInfo
-> HashMap Name RemoteSchemaInputValueDefinition
_rrfiRemoteFields :: RemoteSchemaFieldInfo -> RemoteFields
_rrfiRemoteSchema :: RemoteSchemaFieldInfo -> RemoteSchemaInfo
_rrfiInputValueDefinitions :: RemoteSchemaFieldInfo
-> [TypeDefinition [Name] RemoteSchemaInputValueDefinition]
_rrfiRemoteSchemaName :: RemoteSchemaFieldInfo -> RemoteSchemaName
_rrfiLHSIdentifier :: RemoteSchemaFieldInfo -> LHSIdentifier
_rrfiName :: RelName
_rrfiParamMap :: HashMap Name RemoteSchemaInputValueDefinition
_rrfiRemoteFields :: RemoteFields
_rrfiRemoteSchema :: RemoteSchemaInfo
_rrfiInputValueDefinitions :: [TypeDefinition [Name] RemoteSchemaInputValueDefinition]
_rrfiRemoteSchemaName :: RemoteSchemaName
_rrfiLHSIdentifier :: LHSIdentifier
..} =
    [Pair] -> Value
J.object
      [ Key
"name" Key -> RelName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= RelName
_rrfiName,
        Key
"param_map" Key -> HashMap Name Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (RemoteSchemaInputValueDefinition -> Value)
-> HashMap Name RemoteSchemaInputValueDefinition
-> HashMap Name Value
forall a b. (a -> b) -> HashMap Name a -> HashMap Name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RemoteSchemaInputValueDefinition -> Value
toJsonInpValInfo HashMap Name RemoteSchemaInputValueDefinition
_rrfiParamMap,
        Key
"remote_fields" Key -> RemoteFields -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= RemoteFields
_rrfiRemoteFields,
        Key
"remote_schema" Key -> RemoteSchemaInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= RemoteSchemaInfo
_rrfiRemoteSchema
      ]
    where
      toJsonInpValInfo :: RemoteSchemaInputValueDefinition -> Value
toJsonInpValInfo (RemoteSchemaInputValueDefinition (G.InputValueDefinition Maybe Description
desc Name
name GType
type' Maybe (Value Void)
defVal [Directive Void]
_directives) Maybe (Value RemoteSchemaVariable)
_preset) =
        [Pair] -> Value
J.object
          [ Key
"desc" Key -> Maybe Description -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Maybe Description
desc,
            Key
"name" Key -> Name -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Name
name,
            Key
"def_val" Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (Value Void -> Value) -> Maybe (Value Void) -> Maybe Value
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value Void -> Value
graphQLValueToJSON Maybe (Value Void)
defVal,
            Key
"type" Key -> GType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= GType
type'
          ]

$(makeLenses ''RemoteSchemaCtxG)