{-# LANGUAGE TemplateHaskell #-}

module Hasura.GraphQL.RemoteServer
  ( fetchRemoteSchema,
    execRemoteGQ,
  )
where

import Control.Arrow.Extended (left)
import Control.Exception (try)
import Control.Lens (set, (^.))
import Control.Monad.Memoize
import Data.Aeson ((.:), (.:?))
import Data.Aeson qualified as J
import Data.ByteString.Lazy qualified as BL
import Data.Environment qualified as Env
import Data.FileEmbed (makeRelativeToProject)
import Data.HashMap.Strict.Extended qualified as Map
import Data.HashSet qualified as Set
import Data.List.Extended (duplicates)
import Data.Text qualified as T
import Data.Text.Extended (dquoteList, (<<>))
import Hasura.Base.Error
import Hasura.GraphQL.Parser.Monad (Parse)
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.NamingCase
import Hasura.GraphQL.Schema.Options (SchemaOptions (..))
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.GraphQL.Schema.Remote (buildRemoteParser)
import Hasura.GraphQL.Schema.Typename
import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.HTTP
import Hasura.Prelude
import Hasura.RQL.DDL.Headers (makeHeadersFromConf)
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.RemoteSchema
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SourceCustomization
import Hasura.Server.Utils
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Parser qualified as G
import Language.GraphQL.Draft.Syntax qualified as G
import Language.Haskell.TH.Syntax qualified as TH
import Network.HTTP.Client.Transformable qualified as HTTP
import Network.URI (URI)
import Network.Wreq qualified as Wreq

-------------------------------------------------------------------------------
-- Core API

-- | Make an introspection query to the remote graphql server for the data we
-- need to present and stitch the remote schema. This powers add_remote_schema,
-- and also is called by schema cache rebuilding code in "Hasura.RQL.DDL.Schema.Cache".
fetchRemoteSchema ::
  forall m.
  (MonadIO m, MonadError QErr m, Tracing.MonadTrace m) =>
  Env.Environment ->
  HTTP.Manager ->
  RemoteSchemaName ->
  ValidatedRemoteSchemaDef ->
  m RemoteSchemaCtx
fetchRemoteSchema :: Environment
-> Manager
-> RemoteSchemaName
-> ValidatedRemoteSchemaDef
-> m RemoteSchemaCtx
fetchRemoteSchema Environment
env Manager
manager RemoteSchemaName
_rscName rsDef :: ValidatedRemoteSchemaDef
rsDef@ValidatedRemoteSchemaDef {Bool
Int
[HeaderConf]
Maybe RemoteSchemaCustomization
EnvRecord URI
_vrsdCustomization :: ValidatedRemoteSchemaDef -> Maybe RemoteSchemaCustomization
_vrsdTimeoutSeconds :: ValidatedRemoteSchemaDef -> Int
_vrsdFwdClientHeaders :: ValidatedRemoteSchemaDef -> Bool
_vrsdHeaders :: ValidatedRemoteSchemaDef -> [HeaderConf]
_vrsdUrl :: ValidatedRemoteSchemaDef -> EnvRecord URI
_vrsdCustomization :: Maybe RemoteSchemaCustomization
_vrsdTimeoutSeconds :: Int
_vrsdFwdClientHeaders :: Bool
_vrsdHeaders :: [HeaderConf]
_vrsdUrl :: EnvRecord URI
..} = do
  (DiffTime
_, [Header]
_, ByteString
_rscRawIntrospectionResult) <-
    Environment
-> Manager
-> UserInfo
-> [Header]
-> ValidatedRemoteSchemaDef
-> GQLReqOutgoing
-> m (DiffTime, [Header], ByteString)
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadTrace m) =>
Environment
-> Manager
-> UserInfo
-> [Header]
-> ValidatedRemoteSchemaDef
-> GQLReqOutgoing
-> m (DiffTime, [Header], ByteString)
execRemoteGQ Environment
env Manager
manager UserInfo
adminUserInfo [] ValidatedRemoteSchemaDef
rsDef GQLReqOutgoing
introspectionQuery

  -- Parse the JSON into flat GraphQL type AST.
  FromIntrospection IntrospectionResult
_rscIntroOriginal <-
    ByteString -> Either String (FromIntrospection IntrospectionResult)
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecode ByteString
_rscRawIntrospectionResult Either String (FromIntrospection IntrospectionResult)
-> (String -> m (FromIntrospection IntrospectionResult))
-> m (FromIntrospection IntrospectionResult)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (Text -> m (FromIntrospection IntrospectionResult)
forall (m :: * -> *) a. QErrM m => Text -> m a
throwRemoteSchema (Text -> m (FromIntrospection IntrospectionResult))
-> (String -> Text)
-> String
-> m (FromIntrospection IntrospectionResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)

  -- Possibly transform type names from the remote schema, per the user's 'RemoteSchemaDef'.
  let rsCustomizer :: RemoteSchemaCustomizer
rsCustomizer = IntrospectionResult
-> Maybe RemoteSchemaCustomization -> RemoteSchemaCustomizer
getCustomizer (IntrospectionResult -> IntrospectionResult
addDefaultRoots IntrospectionResult
_rscIntroOriginal) Maybe RemoteSchemaCustomization
_vrsdCustomization
  RemoteSchemaCustomizer -> RemoteSchemaIntrospection -> m ()
forall (m :: * -> *).
MonadError QErr m =>
RemoteSchemaCustomizer -> RemoteSchemaIntrospection -> m ()
validateSchemaCustomizations RemoteSchemaCustomizer
rsCustomizer (IntrospectionResult -> RemoteSchemaIntrospection
irDoc IntrospectionResult
_rscIntroOriginal)

  -- At this point, we can't resolve remote relationships; we store an empty map.
  let _rscRemoteRelationships :: RemoteSchemaRelationships
_rscRemoteRelationships = RemoteSchemaRelationships
forall a. Monoid a => a
mempty
      _rscInfo :: RemoteSchemaInfo
_rscInfo = RemoteSchemaInfo :: ValidatedRemoteSchemaDef
-> RemoteSchemaCustomizer -> RemoteSchemaInfo
RemoteSchemaInfo {ValidatedRemoteSchemaDef
RemoteSchemaCustomizer
rsCustomizer :: RemoteSchemaCustomizer
rsDef :: ValidatedRemoteSchemaDef
rsCustomizer :: RemoteSchemaCustomizer
rsDef :: ValidatedRemoteSchemaDef
..}

  -- Check that the parsed GraphQL type info is valid by running the schema
  -- generation. The result is discarded, as the local schema will be built
  -- properly for each role at schema generation time, but this allows us to
  -- quickly reject an invalid schema.
  m (RemoteSchemaParser Parse) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (RemoteSchemaParser Parse) -> m ())
-> m (RemoteSchemaParser Parse) -> m ()
forall a b. (a -> b) -> a -> b
$
    (ReaderT
   (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
    SchemaOptions, SchemaContext)
   m
   (RemoteSchemaParser Parse)
 -> (CustomizeRemoteFieldName, MkTypename, MkRootFieldName,
     NamingCase, SchemaOptions, SchemaContext)
 -> m (RemoteSchemaParser Parse))
-> (CustomizeRemoteFieldName, MkTypename, MkRootFieldName,
    NamingCase, SchemaOptions, SchemaContext)
-> ReaderT
     (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
      SchemaOptions, SchemaContext)
     m
     (RemoteSchemaParser Parse)
-> m (RemoteSchemaParser Parse)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
   SchemaOptions, SchemaContext)
  m
  (RemoteSchemaParser Parse)
-> (CustomizeRemoteFieldName, MkTypename, MkRootFieldName,
    NamingCase, SchemaOptions, SchemaContext)
-> m (RemoteSchemaParser Parse)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
 SchemaOptions, SchemaContext)
minimumValidContext (ReaderT
   (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
    SchemaOptions, SchemaContext)
   m
   (RemoteSchemaParser Parse)
 -> m (RemoteSchemaParser Parse))
-> ReaderT
     (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
      SchemaOptions, SchemaContext)
     m
     (RemoteSchemaParser Parse)
-> m (RemoteSchemaParser Parse)
forall a b. (a -> b) -> a -> b
$
      MemoizeT
  (ReaderT
     (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
      SchemaOptions, SchemaContext)
     m)
  (RemoteSchemaParser Parse)
-> ReaderT
     (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
      SchemaOptions, SchemaContext)
     m
     (RemoteSchemaParser Parse)
forall (m :: * -> *) a. Monad m => MemoizeT m a -> m a
runMemoizeT (MemoizeT
   (ReaderT
      (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
       SchemaOptions, SchemaContext)
      m)
   (RemoteSchemaParser Parse)
 -> ReaderT
      (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
       SchemaOptions, SchemaContext)
      m
      (RemoteSchemaParser Parse))
-> MemoizeT
     (ReaderT
        (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
         SchemaOptions, SchemaContext)
        m)
     (RemoteSchemaParser Parse)
-> ReaderT
     (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
      SchemaOptions, SchemaContext)
     m
     (RemoteSchemaParser Parse)
forall a b. (a -> b) -> a -> b
$
        IntrospectionResult
-> RemoteSchemaRelationships
-> RemoteSchemaInfo
-> MemoizeT
     (ReaderT
        (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
         SchemaOptions, SchemaContext)
        m)
     (RemoteSchemaParser Parse)
forall r (m :: * -> *) (n :: * -> *).
MonadBuildRemoteSchema r m n =>
IntrospectionResult
-> RemoteSchemaRelationships
-> RemoteSchemaInfo
-> m (RemoteSchemaParser n)
buildRemoteParser @_ @_ @Parse
          IntrospectionResult
_rscIntroOriginal
          RemoteSchemaRelationships
_rscRemoteRelationships
          RemoteSchemaInfo
_rscInfo

  -- The 'rawIntrospectionResult' contains the 'Bytestring' response of
  -- the introspection result of the remote server. We store this in the
  -- 'RemoteSchemaCtx' because we can use this when the 'introspect_remote_schema'
  -- is called by simple encoding the result to JSON.
  RemoteSchemaCtx -> m RemoteSchemaCtx
forall (m :: * -> *) a. Monad m => a -> m a
return
    RemoteSchemaCtx :: RemoteSchemaName
-> IntrospectionResult
-> RemoteSchemaInfo
-> ByteString
-> HashMap RoleName IntrospectionResult
-> RemoteSchemaRelationships
-> RemoteSchemaCtx
RemoteSchemaCtx
      { _rscPermissions :: HashMap RoleName IntrospectionResult
_rscPermissions = HashMap RoleName IntrospectionResult
forall a. Monoid a => a
mempty,
        ByteString
RemoteSchemaRelationships
RemoteSchemaName
RemoteSchemaInfo
IntrospectionResult
_rscRemoteRelationships :: RemoteSchemaRelationships
_rscRawIntrospectionResult :: ByteString
_rscInfo :: RemoteSchemaInfo
_rscIntroOriginal :: IntrospectionResult
_rscName :: RemoteSchemaName
_rscInfo :: RemoteSchemaInfo
_rscRemoteRelationships :: RemoteSchemaRelationships
_rscIntroOriginal :: IntrospectionResult
_rscRawIntrospectionResult :: ByteString
_rscName :: RemoteSchemaName
..
      }
  where
    -- If there is no explicit mutation or subscription root type we need to check for
    -- objects type definitions with the default names "Mutation" and "Subscription".
    -- If found, we add the default roots explicitly to the IntrospectionResult.
    -- This simplifies the customization code.
    addDefaultRoots :: IntrospectionResult -> IntrospectionResult
    addDefaultRoots :: IntrospectionResult -> IntrospectionResult
addDefaultRoots IntrospectionResult {Maybe Name
Name
RemoteSchemaIntrospection
irSubscriptionRoot :: IntrospectionResult -> Maybe Name
irMutationRoot :: IntrospectionResult -> Maybe Name
irQueryRoot :: IntrospectionResult -> Name
irSubscriptionRoot :: Maybe Name
irMutationRoot :: Maybe Name
irQueryRoot :: Name
irDoc :: RemoteSchemaIntrospection
irDoc :: IntrospectionResult -> RemoteSchemaIntrospection
..} =
      IntrospectionResult :: RemoteSchemaIntrospection
-> Name -> Maybe Name -> Maybe Name -> IntrospectionResult
IntrospectionResult
        { irMutationRoot :: Maybe Name
irMutationRoot = Name -> Maybe Name -> Maybe Name
getRootTypeName Name
GName._Mutation Maybe Name
irMutationRoot,
          irSubscriptionRoot :: Maybe Name
irSubscriptionRoot = Name -> Maybe Name -> Maybe Name
getRootTypeName Name
GName._Subscription Maybe Name
irSubscriptionRoot,
          Name
RemoteSchemaIntrospection
irQueryRoot :: Name
irQueryRoot :: Name
irDoc :: RemoteSchemaIntrospection
irDoc :: RemoteSchemaIntrospection
..
        }
      where
        getRootTypeName :: Name -> Maybe Name -> Maybe Name
getRootTypeName Name
defaultName Maybe Name
providedName =
          Maybe Name
providedName Maybe Name -> Maybe Name -> Maybe Name
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Name
defaultName Name
-> Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
-> Maybe Name
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RemoteSchemaIntrospection
-> Name
-> Maybe (ObjectTypeDefinition RemoteSchemaInputValueDefinition)
lookupObject RemoteSchemaIntrospection
irDoc Name
defaultName)

    -- Minimum valid information required to run schema generation for
    -- the remote schema.
    minimumValidContext :: (CustomizeRemoteFieldName, MkTypename, MkRootFieldName, NamingCase,
 SchemaOptions, SchemaContext)
minimumValidContext =
      ( CustomizeRemoteFieldName
forall a. Monoid a => a
mempty :: CustomizeRemoteFieldName,
        MkTypename
forall a. Monoid a => a
mempty :: MkTypename,
        MkRootFieldName
forall a. Monoid a => a
mempty :: MkRootFieldName,
        NamingCase
HasuraCase,
        SchemaOptions :: StringifyNumbers
-> DangerouslyCollapseBooleans
-> InferFunctionPermissions
-> OptimizePermissionFilters
-> SchemaOptions
SchemaOptions
          { -- doesn't apply to remote schemas
            soStringifyNumbers :: StringifyNumbers
soStringifyNumbers = StringifyNumbers
Options.Don'tStringifyNumbers,
            -- doesn't apply to remote schemas
            soDangerousBooleanCollapse :: DangerouslyCollapseBooleans
soDangerousBooleanCollapse = DangerouslyCollapseBooleans
Options.DangerouslyCollapseBooleans,
            -- we don't support remote schemas in Relay, but the check is
            -- performed ahead of time, meaning that the value here is
            -- irrelevant
            -- doesn't apply to remote schemas
            soInferFunctionPermissions :: InferFunctionPermissions
soInferFunctionPermissions = InferFunctionPermissions
Options.InferFunctionPermissions,
            -- doesn't apply to remote schemas
            soOptimizePermissionFilters :: OptimizePermissionFilters
soOptimizePermissionFilters = OptimizePermissionFilters
Options.Don'tOptimizePermissionFilters
          },
        SchemaKind
-> RemoteRelationshipParserBuilder -> RoleName -> SchemaContext
SchemaContext
          SchemaKind
HasuraSchema
          RemoteRelationshipParserBuilder
ignoreRemoteRelationship
          RoleName
adminRoleName
      )

-- | Sends a GraphQL query to the given server.
execRemoteGQ ::
  ( MonadIO m,
    MonadError QErr m,
    Tracing.MonadTrace m
  ) =>
  Env.Environment ->
  HTTP.Manager ->
  UserInfo ->
  [HTTP.Header] ->
  ValidatedRemoteSchemaDef ->
  GQLReqOutgoing ->
  -- | Returns the response body and headers, along with the time taken for the
  -- HTTP request to complete
  m (DiffTime, [HTTP.Header], BL.ByteString)
execRemoteGQ :: Environment
-> Manager
-> UserInfo
-> [Header]
-> ValidatedRemoteSchemaDef
-> GQLReqOutgoing
-> m (DiffTime, [Header], ByteString)
execRemoteGQ Environment
env Manager
manager UserInfo
userInfo [Header]
reqHdrs ValidatedRemoteSchemaDef
rsdef gqlReq :: GQLReqOutgoing
gqlReq@GQLReq {Maybe VariableValues
Maybe OperationName
SingleOperation
_grVariables :: forall a. GQLReq a -> Maybe VariableValues
_grQuery :: forall a. GQLReq a -> a
_grOperationName :: forall a. GQLReq a -> Maybe OperationName
_grVariables :: Maybe VariableValues
_grQuery :: SingleOperation
_grOperationName :: Maybe OperationName
..} = do
  let gqlReqUnparsed :: GQLReqUnparsed
gqlReqUnparsed = GQLReqOutgoing -> GQLReqUnparsed
renderGQLReqOutgoing GQLReqOutgoing
gqlReq

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SingleOperation -> OperationType
forall (frag :: * -> *) var.
TypedOperationDefinition frag var -> OperationType
G._todType SingleOperation
_grQuery OperationType -> OperationType -> Bool
forall a. Eq a => a -> a -> Bool
== OperationType
G.OperationTypeSubscription) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throwRemoteSchema Text
"subscription to remote server is not supported"
  [Header]
confHdrs <- Environment -> [HeaderConf] -> m [Header]
forall (m :: * -> *).
MonadError QErr m =>
Environment -> [HeaderConf] -> m [Header]
makeHeadersFromConf Environment
env [HeaderConf]
hdrConf
  let clientHdrs :: [Header]
clientHdrs = [Header] -> [Header] -> Bool -> [Header]
forall a. a -> a -> Bool -> a
bool [] ([Header] -> [Header]
mkClientHeadersForward [Header]
reqHdrs) Bool
fwdClientHdrs
      -- filter out duplicate headers
      -- priority: conf headers > resolved userinfo vars > client headers
      hdrMaps :: [HashMap HeaderName ByteString]
hdrMaps =
        [ [Header] -> HashMap HeaderName ByteString
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList [Header]
confHdrs,
          [Header] -> HashMap HeaderName ByteString
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList [Header]
userInfoToHdrs,
          [Header] -> HashMap HeaderName ByteString
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList [Header]
clientHdrs
        ]
      headers :: [Header]
headers = HashMap HeaderName ByteString -> [Header]
forall k v. HashMap k v -> [(k, v)]
Map.toList (HashMap HeaderName ByteString -> [Header])
-> HashMap HeaderName ByteString -> [Header]
forall a b. (a -> b) -> a -> b
$ (HashMap HeaderName ByteString
 -> HashMap HeaderName ByteString -> HashMap HeaderName ByteString)
-> HashMap HeaderName ByteString
-> [HashMap HeaderName ByteString]
-> HashMap HeaderName ByteString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr HashMap HeaderName ByteString
-> HashMap HeaderName ByteString -> HashMap HeaderName ByteString
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
Map.union HashMap HeaderName ByteString
forall k v. HashMap k v
Map.empty [HashMap HeaderName ByteString]
hdrMaps
      finalHeaders :: [Header]
finalHeaders = [Header] -> [Header]
addDefaultHeaders [Header]
headers
  Request
initReq <- Either HttpException Request
-> (HttpException -> m Request) -> m Request
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft (Text -> Either HttpException Request
HTTP.mkRequestEither (Text -> Either HttpException Request)
-> Text -> Either HttpException Request
forall a b. (a -> b) -> a -> b
$ URI -> Text
forall a. Show a => a -> Text
tshow URI
url) (EnvRecord URI -> HttpException -> m Request
forall (m :: * -> *) a.
QErrM m =>
EnvRecord URI -> HttpException -> m a
throwRemoteSchemaHttp EnvRecord URI
webhookEnvRecord)
  let req :: Request
req =
        Request
initReq Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request ByteString ByteString
-> ByteString -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request ByteString ByteString
Lens' Request ByteString
HTTP.method ByteString
"POST"
          Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request [Header] [Header]
-> [Header] -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request [Header] [Header]
Lens' Request [Header]
HTTP.headers [Header]
finalHeaders
          Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request (Maybe ByteString) (Maybe ByteString)
-> Maybe ByteString -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request (Maybe ByteString) (Maybe ByteString)
Lens' Request (Maybe ByteString)
HTTP.body (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode GQLReqUnparsed
gqlReqUnparsed)
          Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ASetter Request Request ResponseTimeout ResponseTimeout
-> ResponseTimeout -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Request Request ResponseTimeout ResponseTimeout
Lens' Request ResponseTimeout
HTTP.timeout (Int -> ResponseTimeout
HTTP.responseTimeoutMicro (Int
timeout Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000))

  Request
-> (Request -> m (DiffTime, [Header], ByteString))
-> m (DiffTime, [Header], ByteString)
forall (m :: * -> *) a.
MonadTrace m =>
Request -> (Request -> m a) -> m a
Tracing.tracedHttpRequest Request
req \Request
req' -> do
    (DiffTime
time, Either HttpException (Response ByteString)
res) <- m (Either HttpException (Response ByteString))
-> m (DiffTime, Either HttpException (Response ByteString))
forall (m :: * -> *) a. MonadIO m => m a -> m (DiffTime, a)
withElapsedTime (m (Either HttpException (Response ByteString))
 -> m (DiffTime, Either HttpException (Response ByteString)))
-> m (Either HttpException (Response ByteString))
-> m (DiffTime, Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Either HttpException (Response ByteString))
-> m (Either HttpException (Response ByteString))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HttpException (Response ByteString))
 -> m (Either HttpException (Response ByteString)))
-> IO (Either HttpException (Response ByteString))
-> m (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> IO (Either HttpException (Response ByteString))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Response ByteString)
 -> IO (Either HttpException (Response ByteString)))
-> IO (Response ByteString)
-> IO (Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
HTTP.performRequest Request
req' Manager
manager
    Response ByteString
resp <- Either HttpException (Response ByteString)
-> (HttpException -> m (Response ByteString))
-> m (Response ByteString)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft Either HttpException (Response ByteString)
res (EnvRecord URI -> HttpException -> m (Response ByteString)
forall (m :: * -> *) a.
QErrM m =>
EnvRecord URI -> HttpException -> m a
throwRemoteSchemaHttp EnvRecord URI
webhookEnvRecord)
    (DiffTime, [Header], ByteString)
-> m (DiffTime, [Header], ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiffTime
time, Response ByteString -> [Header]
forall a. Response a -> [Header]
mkSetCookieHeaders Response ByteString
resp, Response ByteString
resp Response ByteString
-> Getting ByteString (Response ByteString) ByteString
-> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString (Response ByteString) ByteString
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody)
  where
    ValidatedRemoteSchemaDef EnvRecord URI
webhookEnvRecord [HeaderConf]
hdrConf Bool
fwdClientHdrs Int
timeout Maybe RemoteSchemaCustomization
_mPrefix = ValidatedRemoteSchemaDef
rsdef
    url :: URI
url = EnvRecord URI -> URI
forall a. EnvRecord a -> a
_envVarValue EnvRecord URI
webhookEnvRecord
    userInfoToHdrs :: [Header]
userInfoToHdrs = SessionVariables -> [Header]
sessionVariablesToHeaders (SessionVariables -> [Header]) -> SessionVariables -> [Header]
forall a b. (a -> b) -> a -> b
$ UserInfo -> SessionVariables
_uiSession UserInfo
userInfo

-------------------------------------------------------------------------------
-- Validation

validateSchemaCustomizations ::
  forall m.
  MonadError QErr m =>
  RemoteSchemaCustomizer ->
  RemoteSchemaIntrospection ->
  m ()
validateSchemaCustomizations :: RemoteSchemaCustomizer -> RemoteSchemaIntrospection -> m ()
validateSchemaCustomizations RemoteSchemaCustomizer
remoteSchemaCustomizer RemoteSchemaIntrospection
remoteSchemaIntrospection = do
  RemoteSchemaCustomizer -> RemoteSchemaIntrospection -> m ()
forall (m :: * -> *).
MonadError QErr m =>
RemoteSchemaCustomizer -> RemoteSchemaIntrospection -> m ()
validateSchemaCustomizationsConsistent RemoteSchemaCustomizer
remoteSchemaCustomizer RemoteSchemaIntrospection
remoteSchemaIntrospection
  RemoteSchemaCustomizer -> RemoteSchemaIntrospection -> m ()
forall (m :: * -> *).
MonadError QErr m =>
RemoteSchemaCustomizer -> RemoteSchemaIntrospection -> m ()
validateSchemaCustomizationsDistinct RemoteSchemaCustomizer
remoteSchemaCustomizer RemoteSchemaIntrospection
remoteSchemaIntrospection

validateSchemaCustomizationsConsistent ::
  forall m.
  MonadError QErr m =>
  RemoteSchemaCustomizer ->
  RemoteSchemaIntrospection ->
  m ()
validateSchemaCustomizationsConsistent :: RemoteSchemaCustomizer -> RemoteSchemaIntrospection -> m ()
validateSchemaCustomizationsConsistent RemoteSchemaCustomizer
remoteSchemaCustomizer (RemoteSchemaIntrospection HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
typeDefinitions) = do
  (TypeDefinition [Name] RemoteSchemaInputValueDefinition -> m ())
-> HashMap
     Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ TypeDefinition [Name] RemoteSchemaInputValueDefinition -> m ()
forall a. TypeDefinition [Name] a -> m ()
validateInterfaceFields HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
typeDefinitions
  where
    customizeFieldName :: CustomizeRemoteFieldName
customizeFieldName = RemoteSchemaCustomizer -> CustomizeRemoteFieldName
remoteSchemaCustomizeFieldName RemoteSchemaCustomizer
remoteSchemaCustomizer

    validateInterfaceFields :: G.TypeDefinition [G.Name] a -> m ()
    validateInterfaceFields :: TypeDefinition [Name] a -> m ()
validateInterfaceFields = \case
      G.TypeDefinitionInterface G.InterfaceTypeDefinition {[Directive Void]
[FieldDefinition a]
[Name]
Maybe Description
Name
_itdPossibleTypes :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> possibleTypes
_itdName :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> Name
_itdFieldsDefinition :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType
-> [FieldDefinition inputType]
_itdDirectives :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> [Directive Void]
_itdDescription :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType
-> Maybe Description
_itdPossibleTypes :: [Name]
_itdFieldsDefinition :: [FieldDefinition a]
_itdDirectives :: [Directive Void]
_itdName :: Name
_itdDescription :: Maybe Description
..} ->
        [Name] -> (Name -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Name]
_itdPossibleTypes ((Name -> m ()) -> m ()) -> (Name -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Name
typeName ->
          [FieldDefinition a] -> (FieldDefinition a -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [FieldDefinition a]
_itdFieldsDefinition ((FieldDefinition a -> m ()) -> m ())
-> (FieldDefinition a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \G.FieldDefinition {ArgumentsDefinition a
[Directive Void]
Maybe Description
GType
Name
_fldType :: forall inputType. FieldDefinition inputType -> GType
_fldName :: forall inputType. FieldDefinition inputType -> Name
_fldDirectives :: forall inputType. FieldDefinition inputType -> [Directive Void]
_fldDescription :: forall inputType. FieldDefinition inputType -> Maybe Description
_fldArgumentsDefinition :: forall inputType.
FieldDefinition inputType -> ArgumentsDefinition inputType
_fldDirectives :: [Directive Void]
_fldType :: GType
_fldArgumentsDefinition :: ArgumentsDefinition a
_fldName :: Name
_fldDescription :: Maybe Description
..} -> do
            let interfaceCustomizedFieldName :: Name
interfaceCustomizedFieldName = CustomizeRemoteFieldName -> Name -> Name -> Name
runCustomizeRemoteFieldName CustomizeRemoteFieldName
customizeFieldName Name
_itdName Name
_fldName
                typeCustomizedFieldName :: Name
typeCustomizedFieldName = CustomizeRemoteFieldName -> Name -> Name -> Name
runCustomizeRemoteFieldName CustomizeRemoteFieldName
customizeFieldName Name
typeName Name
_fldName
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name
interfaceCustomizedFieldName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
typeCustomizedFieldName) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
              Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throwRemoteSchema (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
                Text
"Remote schema customization inconsistency: field name mapping for field "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
_fldName
                  Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" of interface "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
_itdName
                  Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is inconsistent with mapping for type "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
typeName
                  Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
". Interface field name maps to "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
interfaceCustomizedFieldName
                  Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
". Type field name maps to "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
typeCustomizedFieldName
                  Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
"."
      TypeDefinition [Name] a
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

validateSchemaCustomizationsDistinct ::
  forall m.
  MonadError QErr m =>
  RemoteSchemaCustomizer ->
  RemoteSchemaIntrospection ->
  m ()
validateSchemaCustomizationsDistinct :: RemoteSchemaCustomizer -> RemoteSchemaIntrospection -> m ()
validateSchemaCustomizationsDistinct RemoteSchemaCustomizer
remoteSchemaCustomizer (RemoteSchemaIntrospection HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
typeDefinitions) = do
  m ()
validateTypeMappingsAreDistinct
  (TypeDefinition [Name] RemoteSchemaInputValueDefinition -> m ())
-> HashMap
     Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ TypeDefinition [Name] RemoteSchemaInputValueDefinition -> m ()
forall a b. TypeDefinition a b -> m ()
validateFieldMappingsAreDistinct HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
typeDefinitions
  where
    customizeTypeName :: MkTypename
customizeTypeName = RemoteSchemaCustomizer -> MkTypename
remoteSchemaCustomizeTypeName RemoteSchemaCustomizer
remoteSchemaCustomizer
    customizeFieldName :: Name -> Name -> Name
customizeFieldName = CustomizeRemoteFieldName -> Name -> Name -> Name
runCustomizeRemoteFieldName (RemoteSchemaCustomizer -> CustomizeRemoteFieldName
remoteSchemaCustomizeFieldName RemoteSchemaCustomizer
remoteSchemaCustomizer)

    validateTypeMappingsAreDistinct :: m ()
    validateTypeMappingsAreDistinct :: m ()
validateTypeMappingsAreDistinct = do
      let dups :: HashSet Name
dups = [Name] -> HashSet Name
forall a. (Eq a, Hashable a) => [a] -> HashSet a
duplicates ([Name] -> HashSet Name) -> [Name] -> HashSet Name
forall a b. (a -> b) -> a -> b
$ MkTypename -> Name -> Name
runMkTypename MkTypename
customizeTypeName (Name -> Name) -> [Name] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> [Name]
forall k v. HashMap k v -> [k]
Map.keys HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
typeDefinitions
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashSet Name -> Bool
forall a. HashSet a -> Bool
Set.null HashSet Name
dups) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throwRemoteSchema (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
          Text
"Type name mappings are not distinct; the following types appear more than once: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashSet Name -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList HashSet Name
dups

    validateFieldMappingsAreDistinct :: G.TypeDefinition a b -> m ()
    validateFieldMappingsAreDistinct :: TypeDefinition a b -> m ()
validateFieldMappingsAreDistinct = \case
      G.TypeDefinitionInterface G.InterfaceTypeDefinition {a
[Directive Void]
[FieldDefinition b]
Maybe Description
Name
_itdPossibleTypes :: a
_itdFieldsDefinition :: [FieldDefinition b]
_itdDirectives :: [Directive Void]
_itdName :: Name
_itdDescription :: Maybe Description
_itdPossibleTypes :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> possibleTypes
_itdName :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> Name
_itdFieldsDefinition :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType
-> [FieldDefinition inputType]
_itdDirectives :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> [Directive Void]
_itdDescription :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType
-> Maybe Description
..} -> do
        let dups :: HashSet Name
dups = [Name] -> HashSet Name
forall a. (Eq a, Hashable a) => [a] -> HashSet a
duplicates ([Name] -> HashSet Name) -> [Name] -> HashSet Name
forall a b. (a -> b) -> a -> b
$ Name -> Name -> Name
customizeFieldName Name
_itdName (Name -> Name)
-> (FieldDefinition b -> Name) -> FieldDefinition b -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDefinition b -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName (FieldDefinition b -> Name) -> [FieldDefinition b] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldDefinition b]
_itdFieldsDefinition
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashSet Name -> Bool
forall a. HashSet a -> Bool
Set.null HashSet Name
dups) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throwRemoteSchema (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
            Text
"Field name mappings for interface type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
_itdName
              Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" are not distinct; the following fields appear more than once: "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashSet Name -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList HashSet Name
dups
      G.TypeDefinitionObject G.ObjectTypeDefinition {[Directive Void]
[FieldDefinition b]
[Name]
Maybe Description
Name
_otdName :: forall inputType. ObjectTypeDefinition inputType -> Name
_otdImplementsInterfaces :: forall inputType. ObjectTypeDefinition inputType -> [Name]
_otdFieldsDefinition :: forall inputType.
ObjectTypeDefinition inputType -> [FieldDefinition inputType]
_otdDirectives :: forall inputType.
ObjectTypeDefinition inputType -> [Directive Void]
_otdDescription :: forall inputType.
ObjectTypeDefinition inputType -> Maybe Description
_otdFieldsDefinition :: [FieldDefinition b]
_otdDirectives :: [Directive Void]
_otdImplementsInterfaces :: [Name]
_otdName :: Name
_otdDescription :: Maybe Description
..} -> do
        let dups :: HashSet Name
dups = [Name] -> HashSet Name
forall a. (Eq a, Hashable a) => [a] -> HashSet a
duplicates ([Name] -> HashSet Name) -> [Name] -> HashSet Name
forall a b. (a -> b) -> a -> b
$ Name -> Name -> Name
customizeFieldName Name
_otdName (Name -> Name)
-> (FieldDefinition b -> Name) -> FieldDefinition b -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDefinition b -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName (FieldDefinition b -> Name) -> [FieldDefinition b] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldDefinition b]
_otdFieldsDefinition
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashSet Name -> Bool
forall a. HashSet a -> Bool
Set.null HashSet Name
dups) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throwRemoteSchema (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
            Text
"Field name mappings for object type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
_otdName
              Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" are not distinct; the following fields appear more than once: "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HashSet Name -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList HashSet Name
dups
      TypeDefinition a b
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-------------------------------------------------------------------------------
-- Introspection

introspectionQuery :: GQLReqOutgoing
introspectionQuery :: GQLReqOutgoing
introspectionQuery =
  $( do
       fp <- makeRelativeToProject "src-rsr/introspection.json"
       TH.qAddDependentFile fp
       eitherResult <- TH.runIO $ J.eitherDecodeFileStrict fp
       either fail TH.lift $ do
         r@GQLReq {..} <- eitherResult
         op <- left (T.unpack . showQErr) $ getSingleOperation r
         pure GQLReq {_grQuery = op, ..}
   )

-- | Parsing the introspection query result.  We use this newtype wrapper to
-- avoid orphan instances and parse JSON in the way that we need for GraphQL
-- introspection results.
newtype FromIntrospection a = FromIntrospection {FromIntrospection a -> a
fromIntrospection :: a}
  deriving (Int -> FromIntrospection a -> ShowS
[FromIntrospection a] -> ShowS
FromIntrospection a -> String
(Int -> FromIntrospection a -> ShowS)
-> (FromIntrospection a -> String)
-> ([FromIntrospection a] -> ShowS)
-> Show (FromIntrospection a)
forall a. Show a => Int -> FromIntrospection a -> ShowS
forall a. Show a => [FromIntrospection a] -> ShowS
forall a. Show a => FromIntrospection a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromIntrospection a] -> ShowS
$cshowList :: forall a. Show a => [FromIntrospection a] -> ShowS
show :: FromIntrospection a -> String
$cshow :: forall a. Show a => FromIntrospection a -> String
showsPrec :: Int -> FromIntrospection a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FromIntrospection a -> ShowS
Show, FromIntrospection a -> FromIntrospection a -> Bool
(FromIntrospection a -> FromIntrospection a -> Bool)
-> (FromIntrospection a -> FromIntrospection a -> Bool)
-> Eq (FromIntrospection a)
forall a.
Eq a =>
FromIntrospection a -> FromIntrospection a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromIntrospection a -> FromIntrospection a -> Bool
$c/= :: forall a.
Eq a =>
FromIntrospection a -> FromIntrospection a -> Bool
== :: FromIntrospection a -> FromIntrospection a -> Bool
$c== :: forall a.
Eq a =>
FromIntrospection a -> FromIntrospection a -> Bool
Eq, (forall x. FromIntrospection a -> Rep (FromIntrospection a) x)
-> (forall x. Rep (FromIntrospection a) x -> FromIntrospection a)
-> Generic (FromIntrospection a)
forall x. Rep (FromIntrospection a) x -> FromIntrospection a
forall x. FromIntrospection a -> Rep (FromIntrospection a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FromIntrospection a) x -> FromIntrospection a
forall a x. FromIntrospection a -> Rep (FromIntrospection a) x
$cto :: forall a x. Rep (FromIntrospection a) x -> FromIntrospection a
$cfrom :: forall a x. FromIntrospection a -> Rep (FromIntrospection a) x
Generic, a -> FromIntrospection b -> FromIntrospection a
(a -> b) -> FromIntrospection a -> FromIntrospection b
(forall a b.
 (a -> b) -> FromIntrospection a -> FromIntrospection b)
-> (forall a b. a -> FromIntrospection b -> FromIntrospection a)
-> Functor FromIntrospection
forall a b. a -> FromIntrospection b -> FromIntrospection a
forall a b. (a -> b) -> FromIntrospection a -> FromIntrospection b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FromIntrospection b -> FromIntrospection a
$c<$ :: forall a b. a -> FromIntrospection b -> FromIntrospection a
fmap :: (a -> b) -> FromIntrospection a -> FromIntrospection b
$cfmap :: forall a b. (a -> b) -> FromIntrospection a -> FromIntrospection b
Functor)

instance J.FromJSON (FromIntrospection G.Description) where
  parseJSON :: Value -> Parser (FromIntrospection Description)
parseJSON = (Text -> FromIntrospection Description)
-> Parser Text -> Parser (FromIntrospection Description)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Description -> FromIntrospection Description
forall a. a -> FromIntrospection a
FromIntrospection (Description -> FromIntrospection Description)
-> (Text -> Description) -> Text -> FromIntrospection Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Description
G.Description) (Parser Text -> Parser (FromIntrospection Description))
-> (Value -> Parser Text)
-> Value
-> Parser (FromIntrospection Description)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
J.parseJSON

instance J.FromJSON (FromIntrospection G.ScalarTypeDefinition) where
  parseJSON :: Value -> Parser (FromIntrospection ScalarTypeDefinition)
parseJSON = String
-> (Object -> Parser (FromIntrospection ScalarTypeDefinition))
-> Value
-> Parser (FromIntrospection ScalarTypeDefinition)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"ScalarTypeDefinition" ((Object -> Parser (FromIntrospection ScalarTypeDefinition))
 -> Value -> Parser (FromIntrospection ScalarTypeDefinition))
-> (Object -> Parser (FromIntrospection ScalarTypeDefinition))
-> Value
-> Parser (FromIntrospection ScalarTypeDefinition)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
kind <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    Name
name <- Object
o Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe (FromIntrospection Description)
desc <- Object
o Object -> Key -> Parser (Maybe (FromIntrospection Description))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"SCALAR") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Parser ()
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
kindErr Text
kind Text
"scalar"
    let desc' :: Maybe Description
desc' = (FromIntrospection Description -> Description)
-> Maybe (FromIntrospection Description) -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection Description -> Description
forall a. FromIntrospection a -> a
fromIntrospection Maybe (FromIntrospection Description)
desc
        r :: ScalarTypeDefinition
r = Maybe Description
-> Name -> [Directive Void] -> ScalarTypeDefinition
G.ScalarTypeDefinition Maybe Description
desc' Name
name []
    FromIntrospection ScalarTypeDefinition
-> Parser (FromIntrospection ScalarTypeDefinition)
forall (m :: * -> *) a. Monad m => a -> m a
return (FromIntrospection ScalarTypeDefinition
 -> Parser (FromIntrospection ScalarTypeDefinition))
-> FromIntrospection ScalarTypeDefinition
-> Parser (FromIntrospection ScalarTypeDefinition)
forall a b. (a -> b) -> a -> b
$ ScalarTypeDefinition -> FromIntrospection ScalarTypeDefinition
forall a. a -> FromIntrospection a
FromIntrospection ScalarTypeDefinition
r

instance J.FromJSON (FromIntrospection (G.ObjectTypeDefinition G.InputValueDefinition)) where
  parseJSON :: Value
-> Parser
     (FromIntrospection (ObjectTypeDefinition InputValueDefinition))
parseJSON = String
-> (Object
    -> Parser
         (FromIntrospection (ObjectTypeDefinition InputValueDefinition)))
-> Value
-> Parser
     (FromIntrospection (ObjectTypeDefinition InputValueDefinition))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"ObjectTypeDefinition" ((Object
  -> Parser
       (FromIntrospection (ObjectTypeDefinition InputValueDefinition)))
 -> Value
 -> Parser
      (FromIntrospection (ObjectTypeDefinition InputValueDefinition)))
-> (Object
    -> Parser
         (FromIntrospection (ObjectTypeDefinition InputValueDefinition)))
-> Value
-> Parser
     (FromIntrospection (ObjectTypeDefinition InputValueDefinition))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
kind <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    Name
name <- Object
o Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe (FromIntrospection Description)
desc <- Object
o Object -> Key -> Parser (Maybe (FromIntrospection Description))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
    Maybe [FromIntrospection (FieldDefinition InputValueDefinition)]
fields <- Object
o Object
-> Key
-> Parser
     (Maybe [FromIntrospection (FieldDefinition InputValueDefinition)])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fields"
    Maybe
  [FromIntrospection
     (InterfaceTypeDefinition [Name] InputValueDefinition)]
interfaces :: Maybe [FromIntrospection (G.InterfaceTypeDefinition [G.Name] G.InputValueDefinition)] <- Object
o Object
-> Key
-> Parser
     (Maybe
        [FromIntrospection
           (InterfaceTypeDefinition [Name] InputValueDefinition)])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"interfaces"
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"OBJECT") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Parser ()
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
kindErr Text
kind Text
"object"
    let implIfaces :: [Name]
implIfaces = (InterfaceTypeDefinition [Name] InputValueDefinition -> Name)
-> [InterfaceTypeDefinition [Name] InputValueDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map InterfaceTypeDefinition [Name] InputValueDefinition -> Name
forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> Name
G._itdName ([InterfaceTypeDefinition [Name] InputValueDefinition] -> [Name])
-> [InterfaceTypeDefinition [Name] InputValueDefinition] -> [Name]
forall a b. (a -> b) -> a -> b
$ [InterfaceTypeDefinition [Name] InputValueDefinition]
-> ([FromIntrospection
       (InterfaceTypeDefinition [Name] InputValueDefinition)]
    -> [InterfaceTypeDefinition [Name] InputValueDefinition])
-> Maybe
     [FromIntrospection
        (InterfaceTypeDefinition [Name] InputValueDefinition)]
-> [InterfaceTypeDefinition [Name] InputValueDefinition]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((FromIntrospection
   (InterfaceTypeDefinition [Name] InputValueDefinition)
 -> InterfaceTypeDefinition [Name] InputValueDefinition)
-> [FromIntrospection
      (InterfaceTypeDefinition [Name] InputValueDefinition)]
-> [InterfaceTypeDefinition [Name] InputValueDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection
  (InterfaceTypeDefinition [Name] InputValueDefinition)
-> InterfaceTypeDefinition [Name] InputValueDefinition
forall a. FromIntrospection a -> a
fromIntrospection) Maybe
  [FromIntrospection
     (InterfaceTypeDefinition [Name] InputValueDefinition)]
interfaces
        flds :: [FieldDefinition InputValueDefinition]
flds = [FieldDefinition InputValueDefinition]
-> ([FromIntrospection (FieldDefinition InputValueDefinition)]
    -> [FieldDefinition InputValueDefinition])
-> Maybe [FromIntrospection (FieldDefinition InputValueDefinition)]
-> [FieldDefinition InputValueDefinition]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((FromIntrospection (FieldDefinition InputValueDefinition)
 -> FieldDefinition InputValueDefinition)
-> [FromIntrospection (FieldDefinition InputValueDefinition)]
-> [FieldDefinition InputValueDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection (FieldDefinition InputValueDefinition)
-> FieldDefinition InputValueDefinition
forall a. FromIntrospection a -> a
fromIntrospection) Maybe [FromIntrospection (FieldDefinition InputValueDefinition)]
fields
        desc' :: Maybe Description
desc' = (FromIntrospection Description -> Description)
-> Maybe (FromIntrospection Description) -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection Description -> Description
forall a. FromIntrospection a -> a
fromIntrospection Maybe (FromIntrospection Description)
desc
        r :: ObjectTypeDefinition InputValueDefinition
r = Maybe Description
-> Name
-> [Name]
-> [Directive Void]
-> [FieldDefinition InputValueDefinition]
-> ObjectTypeDefinition InputValueDefinition
forall inputType.
Maybe Description
-> Name
-> [Name]
-> [Directive Void]
-> [FieldDefinition inputType]
-> ObjectTypeDefinition inputType
G.ObjectTypeDefinition Maybe Description
desc' Name
name [Name]
implIfaces [] [FieldDefinition InputValueDefinition]
flds
    FromIntrospection (ObjectTypeDefinition InputValueDefinition)
-> Parser
     (FromIntrospection (ObjectTypeDefinition InputValueDefinition))
forall (m :: * -> *) a. Monad m => a -> m a
return (FromIntrospection (ObjectTypeDefinition InputValueDefinition)
 -> Parser
      (FromIntrospection (ObjectTypeDefinition InputValueDefinition)))
-> FromIntrospection (ObjectTypeDefinition InputValueDefinition)
-> Parser
     (FromIntrospection (ObjectTypeDefinition InputValueDefinition))
forall a b. (a -> b) -> a -> b
$ ObjectTypeDefinition InputValueDefinition
-> FromIntrospection (ObjectTypeDefinition InputValueDefinition)
forall a. a -> FromIntrospection a
FromIntrospection ObjectTypeDefinition InputValueDefinition
r

instance (J.FromJSON (FromIntrospection a)) => J.FromJSON (FromIntrospection (G.FieldDefinition a)) where
  parseJSON :: Value -> Parser (FromIntrospection (FieldDefinition a))
parseJSON = String
-> (Object -> Parser (FromIntrospection (FieldDefinition a)))
-> Value
-> Parser (FromIntrospection (FieldDefinition a))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"FieldDefinition" ((Object -> Parser (FromIntrospection (FieldDefinition a)))
 -> Value -> Parser (FromIntrospection (FieldDefinition a)))
-> (Object -> Parser (FromIntrospection (FieldDefinition a)))
-> Value
-> Parser (FromIntrospection (FieldDefinition a))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Name
name <- Object
o Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe (FromIntrospection Description)
desc <- Object
o Object -> Key -> Parser (Maybe (FromIntrospection Description))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
    [FromIntrospection a]
args <- Object
o Object -> Key -> Parser [FromIntrospection a]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"args"
    FromIntrospection GType
_type <- Object
o Object -> Key -> Parser (FromIntrospection GType)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    let desc' :: Maybe Description
desc' = (FromIntrospection Description -> Description)
-> Maybe (FromIntrospection Description) -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection Description -> Description
forall a. FromIntrospection a -> a
fromIntrospection Maybe (FromIntrospection Description)
desc
        r :: FieldDefinition a
r =
          Maybe Description
-> Name
-> ArgumentsDefinition a
-> GType
-> [Directive Void]
-> FieldDefinition a
forall inputType.
Maybe Description
-> Name
-> ArgumentsDefinition inputType
-> GType
-> [Directive Void]
-> FieldDefinition inputType
G.FieldDefinition
            Maybe Description
desc'
            Name
name
            ((FromIntrospection a -> a)
-> [FromIntrospection a] -> ArgumentsDefinition a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection a -> a
forall a. FromIntrospection a -> a
fromIntrospection [FromIntrospection a]
args)
            (FromIntrospection GType -> GType
forall a. FromIntrospection a -> a
fromIntrospection FromIntrospection GType
_type)
            []
    FromIntrospection (FieldDefinition a)
-> Parser (FromIntrospection (FieldDefinition a))
forall (m :: * -> *) a. Monad m => a -> m a
return (FromIntrospection (FieldDefinition a)
 -> Parser (FromIntrospection (FieldDefinition a)))
-> FromIntrospection (FieldDefinition a)
-> Parser (FromIntrospection (FieldDefinition a))
forall a b. (a -> b) -> a -> b
$ FieldDefinition a -> FromIntrospection (FieldDefinition a)
forall a. a -> FromIntrospection a
FromIntrospection FieldDefinition a
r

instance J.FromJSON (FromIntrospection G.GType) where
  parseJSON :: Value -> Parser (FromIntrospection GType)
parseJSON = String
-> (Object -> Parser (FromIntrospection GType))
-> Value
-> Parser (FromIntrospection GType)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"GType" ((Object -> Parser (FromIntrospection GType))
 -> Value -> Parser (FromIntrospection GType))
-> (Object -> Parser (FromIntrospection GType))
-> Value
-> Parser (FromIntrospection GType)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
kind <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    Maybe Name
mName <- Object
o Object -> Key -> Parser (Maybe Name)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
    Maybe (FromIntrospection GType)
mType <- Object
o Object -> Key -> Parser (Maybe (FromIntrospection GType))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ofType"
    GType
r <- case (Text
kind, Maybe Name
mName, Maybe (FromIntrospection GType)
mType) of
      (Text
"NON_NULL", Maybe Name
_, Just FromIntrospection GType
typ) -> GType -> Parser GType
forall (m :: * -> *) a. Monad m => a -> m a
return (GType -> Parser GType) -> GType -> Parser GType
forall a b. (a -> b) -> a -> b
$ GType -> GType
mkNotNull (FromIntrospection GType -> GType
forall a. FromIntrospection a -> a
fromIntrospection FromIntrospection GType
typ)
      (Text
"NON_NULL", Maybe Name
_, Maybe (FromIntrospection GType)
Nothing) -> Text -> Parser GType
forall (m :: * -> *) a. MonadFail m => Text -> m a
pErr Text
"NON_NULL should have `ofType`"
      (Text
"LIST", Maybe Name
_, Just FromIntrospection GType
typ) ->
        GType -> Parser GType
forall (m :: * -> *) a. Monad m => a -> m a
return (GType -> Parser GType) -> GType -> Parser GType
forall a b. (a -> b) -> a -> b
$ Nullability -> GType -> GType
G.TypeList (Bool -> Nullability
G.Nullability Bool
True) (FromIntrospection GType -> GType
forall a. FromIntrospection a -> a
fromIntrospection FromIntrospection GType
typ)
      (Text
"LIST", Maybe Name
_, Maybe (FromIntrospection GType)
Nothing) -> Text -> Parser GType
forall (m :: * -> *) a. MonadFail m => Text -> m a
pErr Text
"LIST should have `ofType`"
      (Text
_, Just Name
name, Maybe (FromIntrospection GType)
_) -> GType -> Parser GType
forall (m :: * -> *) a. Monad m => a -> m a
return (GType -> Parser GType) -> GType -> Parser GType
forall a b. (a -> b) -> a -> b
$ Nullability -> Name -> GType
G.TypeNamed (Bool -> Nullability
G.Nullability Bool
True) Name
name
      (Text, Maybe Name, Maybe (FromIntrospection GType))
_ -> Text -> Parser GType
forall (m :: * -> *) a. MonadFail m => Text -> m a
pErr (Text -> Parser GType) -> Text -> Parser GType
forall a b. (a -> b) -> a -> b
$ Text
"kind: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
kind Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" should have name"
    FromIntrospection GType -> Parser (FromIntrospection GType)
forall (m :: * -> *) a. Monad m => a -> m a
return (FromIntrospection GType -> Parser (FromIntrospection GType))
-> FromIntrospection GType -> Parser (FromIntrospection GType)
forall a b. (a -> b) -> a -> b
$ GType -> FromIntrospection GType
forall a. a -> FromIntrospection a
FromIntrospection GType
r
    where
      mkNotNull :: GType -> GType
mkNotNull GType
typ = case GType
typ of
        G.TypeList Nullability
_ GType
ty -> Nullability -> GType -> GType
G.TypeList (Bool -> Nullability
G.Nullability Bool
False) GType
ty
        G.TypeNamed Nullability
_ Name
n -> Nullability -> Name -> GType
G.TypeNamed (Bool -> Nullability
G.Nullability Bool
False) Name
n

instance J.FromJSON (FromIntrospection G.InputValueDefinition) where
  parseJSON :: Value -> Parser (FromIntrospection InputValueDefinition)
parseJSON = String
-> (Object -> Parser (FromIntrospection InputValueDefinition))
-> Value
-> Parser (FromIntrospection InputValueDefinition)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"InputValueDefinition" ((Object -> Parser (FromIntrospection InputValueDefinition))
 -> Value -> Parser (FromIntrospection InputValueDefinition))
-> (Object -> Parser (FromIntrospection InputValueDefinition))
-> Value
-> Parser (FromIntrospection InputValueDefinition)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Name
name <- Object
o Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe (FromIntrospection Description)
desc <- Object
o Object -> Key -> Parser (Maybe (FromIntrospection Description))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
    FromIntrospection GType
_type <- Object
o Object -> Key -> Parser (FromIntrospection GType)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    Maybe (FromIntrospection (Value Void))
defVal <- Object
o Object -> Key -> Parser (Maybe (FromIntrospection (Value Void)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"defaultValue"
    let desc' :: Maybe Description
desc' = (FromIntrospection Description -> Description)
-> Maybe (FromIntrospection Description) -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection Description -> Description
forall a. FromIntrospection a -> a
fromIntrospection Maybe (FromIntrospection Description)
desc
    let defVal' :: Maybe (Value Void)
defVal' = (FromIntrospection (Value Void) -> Value Void)
-> Maybe (FromIntrospection (Value Void)) -> Maybe (Value Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection (Value Void) -> Value Void
forall a. FromIntrospection a -> a
fromIntrospection Maybe (FromIntrospection (Value Void))
defVal
        r :: InputValueDefinition
r = Maybe Description
-> Name
-> GType
-> Maybe (Value Void)
-> [Directive Void]
-> InputValueDefinition
G.InputValueDefinition Maybe Description
desc' Name
name (FromIntrospection GType -> GType
forall a. FromIntrospection a -> a
fromIntrospection FromIntrospection GType
_type) Maybe (Value Void)
defVal' []
    FromIntrospection InputValueDefinition
-> Parser (FromIntrospection InputValueDefinition)
forall (m :: * -> *) a. Monad m => a -> m a
return (FromIntrospection InputValueDefinition
 -> Parser (FromIntrospection InputValueDefinition))
-> FromIntrospection InputValueDefinition
-> Parser (FromIntrospection InputValueDefinition)
forall a b. (a -> b) -> a -> b
$ InputValueDefinition -> FromIntrospection InputValueDefinition
forall a. a -> FromIntrospection a
FromIntrospection InputValueDefinition
r

instance J.FromJSON (FromIntrospection (G.Value Void)) where
  parseJSON :: Value -> Parser (FromIntrospection (Value Void))
parseJSON = String
-> (Text -> Parser (FromIntrospection (Value Void)))
-> Value
-> Parser (FromIntrospection (Value Void))
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"Value Void" ((Text -> Parser (FromIntrospection (Value Void)))
 -> Value -> Parser (FromIntrospection (Value Void)))
-> (Text -> Parser (FromIntrospection (Value Void)))
-> Value
-> Parser (FromIntrospection (Value Void))
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    let parseValueConst :: Text -> Either Text (Value Void)
parseValueConst = Parser (Value Void) -> Text -> Either Text (Value Void)
forall a. Parser a -> Text -> Either Text a
G.runParser Parser (Value Void)
forall var. Variable var => Parser (Value var)
G.value
     in Value Void -> FromIntrospection (Value Void)
forall a. a -> FromIntrospection a
FromIntrospection (Value Void -> FromIntrospection (Value Void))
-> Parser (Value Void) -> Parser (FromIntrospection (Value Void))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Text (Value Void)
-> (Text -> Parser (Value Void)) -> Parser (Value Void)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft (Text -> Either Text (Value Void)
parseValueConst Text
t) (String -> Parser (Value Void)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Value Void))
-> (Text -> String) -> Text -> Parser (Value Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)

instance J.FromJSON (FromIntrospection (G.InterfaceTypeDefinition [G.Name] G.InputValueDefinition)) where
  parseJSON :: Value
-> Parser
     (FromIntrospection
        (InterfaceTypeDefinition [Name] InputValueDefinition))
parseJSON = String
-> (Object
    -> Parser
         (FromIntrospection
            (InterfaceTypeDefinition [Name] InputValueDefinition)))
-> Value
-> Parser
     (FromIntrospection
        (InterfaceTypeDefinition [Name] InputValueDefinition))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"InterfaceTypeDefinition" ((Object
  -> Parser
       (FromIntrospection
          (InterfaceTypeDefinition [Name] InputValueDefinition)))
 -> Value
 -> Parser
      (FromIntrospection
         (InterfaceTypeDefinition [Name] InputValueDefinition)))
-> (Object
    -> Parser
         (FromIntrospection
            (InterfaceTypeDefinition [Name] InputValueDefinition)))
-> Value
-> Parser
     (FromIntrospection
        (InterfaceTypeDefinition [Name] InputValueDefinition))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
kind <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    Name
name <- Object
o Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe (FromIntrospection Description)
desc <- Object
o Object -> Key -> Parser (Maybe (FromIntrospection Description))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
    Maybe [FromIntrospection (FieldDefinition InputValueDefinition)]
fields <- Object
o Object
-> Key
-> Parser
     (Maybe [FromIntrospection (FieldDefinition InputValueDefinition)])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fields"
    Maybe
  [FromIntrospection (ObjectTypeDefinition InputValueDefinition)]
possibleTypes :: Maybe [FromIntrospection (G.ObjectTypeDefinition G.InputValueDefinition)] <- Object
o Object
-> Key
-> Parser
     (Maybe
        [FromIntrospection (ObjectTypeDefinition InputValueDefinition)])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"possibleTypes"
    let flds :: [FieldDefinition InputValueDefinition]
flds = [FieldDefinition InputValueDefinition]
-> ([FromIntrospection (FieldDefinition InputValueDefinition)]
    -> [FieldDefinition InputValueDefinition])
-> Maybe [FromIntrospection (FieldDefinition InputValueDefinition)]
-> [FieldDefinition InputValueDefinition]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((FromIntrospection (FieldDefinition InputValueDefinition)
 -> FieldDefinition InputValueDefinition)
-> [FromIntrospection (FieldDefinition InputValueDefinition)]
-> [FieldDefinition InputValueDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection (FieldDefinition InputValueDefinition)
-> FieldDefinition InputValueDefinition
forall a. FromIntrospection a -> a
fromIntrospection) Maybe [FromIntrospection (FieldDefinition InputValueDefinition)]
fields
        desc' :: Maybe Description
desc' = (FromIntrospection Description -> Description)
-> Maybe (FromIntrospection Description) -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection Description -> Description
forall a. FromIntrospection a -> a
fromIntrospection Maybe (FromIntrospection Description)
desc
        possTps :: [Name]
possTps = (ObjectTypeDefinition InputValueDefinition -> Name)
-> [ObjectTypeDefinition InputValueDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map ObjectTypeDefinition InputValueDefinition -> Name
forall inputType. ObjectTypeDefinition inputType -> Name
G._otdName ([ObjectTypeDefinition InputValueDefinition] -> [Name])
-> [ObjectTypeDefinition InputValueDefinition] -> [Name]
forall a b. (a -> b) -> a -> b
$ [ObjectTypeDefinition InputValueDefinition]
-> ([FromIntrospection (ObjectTypeDefinition InputValueDefinition)]
    -> [ObjectTypeDefinition InputValueDefinition])
-> Maybe
     [FromIntrospection (ObjectTypeDefinition InputValueDefinition)]
-> [ObjectTypeDefinition InputValueDefinition]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((FromIntrospection (ObjectTypeDefinition InputValueDefinition)
 -> ObjectTypeDefinition InputValueDefinition)
-> [FromIntrospection (ObjectTypeDefinition InputValueDefinition)]
-> [ObjectTypeDefinition InputValueDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection (ObjectTypeDefinition InputValueDefinition)
-> ObjectTypeDefinition InputValueDefinition
forall a. FromIntrospection a -> a
fromIntrospection) Maybe
  [FromIntrospection (ObjectTypeDefinition InputValueDefinition)]
possibleTypes
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"INTERFACE") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Parser ()
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
kindErr Text
kind Text
"interface"
    -- TODO (non PDV) track which interfaces implement which other interfaces, after a
    -- GraphQL spec > Jun 2018 is released.
    let r :: InterfaceTypeDefinition [Name] InputValueDefinition
r = Maybe Description
-> Name
-> [Directive Void]
-> [FieldDefinition InputValueDefinition]
-> [Name]
-> InterfaceTypeDefinition [Name] InputValueDefinition
forall possibleTypes inputType.
Maybe Description
-> Name
-> [Directive Void]
-> [FieldDefinition inputType]
-> possibleTypes
-> InterfaceTypeDefinition possibleTypes inputType
G.InterfaceTypeDefinition Maybe Description
desc' Name
name [] [FieldDefinition InputValueDefinition]
flds [Name]
possTps
    FromIntrospection
  (InterfaceTypeDefinition [Name] InputValueDefinition)
-> Parser
     (FromIntrospection
        (InterfaceTypeDefinition [Name] InputValueDefinition))
forall (m :: * -> *) a. Monad m => a -> m a
return (FromIntrospection
   (InterfaceTypeDefinition [Name] InputValueDefinition)
 -> Parser
      (FromIntrospection
         (InterfaceTypeDefinition [Name] InputValueDefinition)))
-> FromIntrospection
     (InterfaceTypeDefinition [Name] InputValueDefinition)
-> Parser
     (FromIntrospection
        (InterfaceTypeDefinition [Name] InputValueDefinition))
forall a b. (a -> b) -> a -> b
$ InterfaceTypeDefinition [Name] InputValueDefinition
-> FromIntrospection
     (InterfaceTypeDefinition [Name] InputValueDefinition)
forall a. a -> FromIntrospection a
FromIntrospection InterfaceTypeDefinition [Name] InputValueDefinition
r

instance J.FromJSON (FromIntrospection G.UnionTypeDefinition) where
  parseJSON :: Value -> Parser (FromIntrospection UnionTypeDefinition)
parseJSON = String
-> (Object -> Parser (FromIntrospection UnionTypeDefinition))
-> Value
-> Parser (FromIntrospection UnionTypeDefinition)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"UnionTypeDefinition" ((Object -> Parser (FromIntrospection UnionTypeDefinition))
 -> Value -> Parser (FromIntrospection UnionTypeDefinition))
-> (Object -> Parser (FromIntrospection UnionTypeDefinition))
-> Value
-> Parser (FromIntrospection UnionTypeDefinition)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
kind <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    Name
name <- Object
o Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe (FromIntrospection Description)
desc <- Object
o Object -> Key -> Parser (Maybe (FromIntrospection Description))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
    [FromIntrospection (ObjectTypeDefinition InputValueDefinition)]
possibleTypes :: [FromIntrospection (G.ObjectTypeDefinition G.InputValueDefinition)] <- Object
o Object
-> Key
-> Parser
     [FromIntrospection (ObjectTypeDefinition InputValueDefinition)]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"possibleTypes"
    let possibleTypes' :: [Name]
possibleTypes' = (ObjectTypeDefinition InputValueDefinition -> Name)
-> [ObjectTypeDefinition InputValueDefinition] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map ObjectTypeDefinition InputValueDefinition -> Name
forall inputType. ObjectTypeDefinition inputType -> Name
G._otdName ([ObjectTypeDefinition InputValueDefinition] -> [Name])
-> [ObjectTypeDefinition InputValueDefinition] -> [Name]
forall a b. (a -> b) -> a -> b
$ (FromIntrospection (ObjectTypeDefinition InputValueDefinition)
 -> ObjectTypeDefinition InputValueDefinition)
-> [FromIntrospection (ObjectTypeDefinition InputValueDefinition)]
-> [ObjectTypeDefinition InputValueDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection (ObjectTypeDefinition InputValueDefinition)
-> ObjectTypeDefinition InputValueDefinition
forall a. FromIntrospection a -> a
fromIntrospection [FromIntrospection (ObjectTypeDefinition InputValueDefinition)]
possibleTypes
        desc' :: Maybe Description
desc' = (FromIntrospection Description -> Description)
-> Maybe (FromIntrospection Description) -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection Description -> Description
forall a. FromIntrospection a -> a
fromIntrospection Maybe (FromIntrospection Description)
desc
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"UNION") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Parser ()
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
kindErr Text
kind Text
"union"
    let r :: UnionTypeDefinition
r = Maybe Description
-> Name -> [Directive Void] -> [Name] -> UnionTypeDefinition
G.UnionTypeDefinition Maybe Description
desc' Name
name [] [Name]
possibleTypes'
    FromIntrospection UnionTypeDefinition
-> Parser (FromIntrospection UnionTypeDefinition)
forall (m :: * -> *) a. Monad m => a -> m a
return (FromIntrospection UnionTypeDefinition
 -> Parser (FromIntrospection UnionTypeDefinition))
-> FromIntrospection UnionTypeDefinition
-> Parser (FromIntrospection UnionTypeDefinition)
forall a b. (a -> b) -> a -> b
$ UnionTypeDefinition -> FromIntrospection UnionTypeDefinition
forall a. a -> FromIntrospection a
FromIntrospection UnionTypeDefinition
r

instance J.FromJSON (FromIntrospection G.EnumTypeDefinition) where
  parseJSON :: Value -> Parser (FromIntrospection EnumTypeDefinition)
parseJSON = String
-> (Object -> Parser (FromIntrospection EnumTypeDefinition))
-> Value
-> Parser (FromIntrospection EnumTypeDefinition)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"EnumTypeDefinition" ((Object -> Parser (FromIntrospection EnumTypeDefinition))
 -> Value -> Parser (FromIntrospection EnumTypeDefinition))
-> (Object -> Parser (FromIntrospection EnumTypeDefinition))
-> Value
-> Parser (FromIntrospection EnumTypeDefinition)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
kind <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    Name
name <- Object
o Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe (FromIntrospection Description)
desc <- Object
o Object -> Key -> Parser (Maybe (FromIntrospection Description))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
    [FromIntrospection EnumValueDefinition]
vals <- Object
o Object -> Key -> Parser [FromIntrospection EnumValueDefinition]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"enumValues"
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"ENUM") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Parser ()
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
kindErr Text
kind Text
"enum"
    let desc' :: Maybe Description
desc' = (FromIntrospection Description -> Description)
-> Maybe (FromIntrospection Description) -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection Description -> Description
forall a. FromIntrospection a -> a
fromIntrospection Maybe (FromIntrospection Description)
desc
    let r :: EnumTypeDefinition
r = Maybe Description
-> Name
-> [Directive Void]
-> [EnumValueDefinition]
-> EnumTypeDefinition
G.EnumTypeDefinition Maybe Description
desc' Name
name [] ((FromIntrospection EnumValueDefinition -> EnumValueDefinition)
-> [FromIntrospection EnumValueDefinition] -> [EnumValueDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection EnumValueDefinition -> EnumValueDefinition
forall a. FromIntrospection a -> a
fromIntrospection [FromIntrospection EnumValueDefinition]
vals)
    FromIntrospection EnumTypeDefinition
-> Parser (FromIntrospection EnumTypeDefinition)
forall (m :: * -> *) a. Monad m => a -> m a
return (FromIntrospection EnumTypeDefinition
 -> Parser (FromIntrospection EnumTypeDefinition))
-> FromIntrospection EnumTypeDefinition
-> Parser (FromIntrospection EnumTypeDefinition)
forall a b. (a -> b) -> a -> b
$ EnumTypeDefinition -> FromIntrospection EnumTypeDefinition
forall a. a -> FromIntrospection a
FromIntrospection EnumTypeDefinition
r

instance J.FromJSON (FromIntrospection G.EnumValueDefinition) where
  parseJSON :: Value -> Parser (FromIntrospection EnumValueDefinition)
parseJSON = String
-> (Object -> Parser (FromIntrospection EnumValueDefinition))
-> Value
-> Parser (FromIntrospection EnumValueDefinition)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"EnumValueDefinition" ((Object -> Parser (FromIntrospection EnumValueDefinition))
 -> Value -> Parser (FromIntrospection EnumValueDefinition))
-> (Object -> Parser (FromIntrospection EnumValueDefinition))
-> Value
-> Parser (FromIntrospection EnumValueDefinition)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    EnumValue
name <- Object
o Object -> Key -> Parser EnumValue
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe (FromIntrospection Description)
desc <- Object
o Object -> Key -> Parser (Maybe (FromIntrospection Description))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
    let desc' :: Maybe Description
desc' = (FromIntrospection Description -> Description)
-> Maybe (FromIntrospection Description) -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection Description -> Description
forall a. FromIntrospection a -> a
fromIntrospection Maybe (FromIntrospection Description)
desc
    let r :: EnumValueDefinition
r = Maybe Description
-> EnumValue -> [Directive Void] -> EnumValueDefinition
G.EnumValueDefinition Maybe Description
desc' EnumValue
name []
    FromIntrospection EnumValueDefinition
-> Parser (FromIntrospection EnumValueDefinition)
forall (m :: * -> *) a. Monad m => a -> m a
return (FromIntrospection EnumValueDefinition
 -> Parser (FromIntrospection EnumValueDefinition))
-> FromIntrospection EnumValueDefinition
-> Parser (FromIntrospection EnumValueDefinition)
forall a b. (a -> b) -> a -> b
$ EnumValueDefinition -> FromIntrospection EnumValueDefinition
forall a. a -> FromIntrospection a
FromIntrospection EnumValueDefinition
r

instance J.FromJSON (FromIntrospection (G.InputObjectTypeDefinition G.InputValueDefinition)) where
  parseJSON :: Value
-> Parser
     (FromIntrospection
        (InputObjectTypeDefinition InputValueDefinition))
parseJSON = String
-> (Object
    -> Parser
         (FromIntrospection
            (InputObjectTypeDefinition InputValueDefinition)))
-> Value
-> Parser
     (FromIntrospection
        (InputObjectTypeDefinition InputValueDefinition))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"InputObjectTypeDefinition" ((Object
  -> Parser
       (FromIntrospection
          (InputObjectTypeDefinition InputValueDefinition)))
 -> Value
 -> Parser
      (FromIntrospection
         (InputObjectTypeDefinition InputValueDefinition)))
-> (Object
    -> Parser
         (FromIntrospection
            (InputObjectTypeDefinition InputValueDefinition)))
-> Value
-> Parser
     (FromIntrospection
        (InputObjectTypeDefinition InputValueDefinition))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
kind <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    Name
name <- Object
o Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe (FromIntrospection Description)
desc <- Object
o Object -> Key -> Parser (Maybe (FromIntrospection Description))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
    Maybe [FromIntrospection InputValueDefinition]
mInputFields <- Object
o Object
-> Key -> Parser (Maybe [FromIntrospection InputValueDefinition])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"inputFields"
    let inputFields :: [InputValueDefinition]
inputFields = [InputValueDefinition]
-> ([FromIntrospection InputValueDefinition]
    -> [InputValueDefinition])
-> Maybe [FromIntrospection InputValueDefinition]
-> [InputValueDefinition]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((FromIntrospection InputValueDefinition -> InputValueDefinition)
-> [FromIntrospection InputValueDefinition]
-> [InputValueDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection InputValueDefinition -> InputValueDefinition
forall a. FromIntrospection a -> a
fromIntrospection) Maybe [FromIntrospection InputValueDefinition]
mInputFields
    let desc' :: Maybe Description
desc' = (FromIntrospection Description -> Description)
-> Maybe (FromIntrospection Description) -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FromIntrospection Description -> Description
forall a. FromIntrospection a -> a
fromIntrospection Maybe (FromIntrospection Description)
desc
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"INPUT_OBJECT") (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Parser ()
forall (m :: * -> *) a. MonadFail m => Text -> Text -> m a
kindErr Text
kind Text
"input_object"
    let r :: InputObjectTypeDefinition InputValueDefinition
r = Maybe Description
-> Name
-> [Directive Void]
-> [InputValueDefinition]
-> InputObjectTypeDefinition InputValueDefinition
forall inputType.
Maybe Description
-> Name
-> [Directive Void]
-> [inputType]
-> InputObjectTypeDefinition inputType
G.InputObjectTypeDefinition Maybe Description
desc' Name
name [] [InputValueDefinition]
inputFields
    FromIntrospection (InputObjectTypeDefinition InputValueDefinition)
-> Parser
     (FromIntrospection
        (InputObjectTypeDefinition InputValueDefinition))
forall (m :: * -> *) a. Monad m => a -> m a
return (FromIntrospection (InputObjectTypeDefinition InputValueDefinition)
 -> Parser
      (FromIntrospection
         (InputObjectTypeDefinition InputValueDefinition)))
-> FromIntrospection
     (InputObjectTypeDefinition InputValueDefinition)
-> Parser
     (FromIntrospection
        (InputObjectTypeDefinition InputValueDefinition))
forall a b. (a -> b) -> a -> b
$ InputObjectTypeDefinition InputValueDefinition
-> FromIntrospection
     (InputObjectTypeDefinition InputValueDefinition)
forall a. a -> FromIntrospection a
FromIntrospection InputObjectTypeDefinition InputValueDefinition
r

instance J.FromJSON (FromIntrospection (G.TypeDefinition [G.Name] G.InputValueDefinition)) where
  parseJSON :: Value
-> Parser
     (FromIntrospection (TypeDefinition [Name] InputValueDefinition))
parseJSON = String
-> (Object
    -> Parser
         (FromIntrospection (TypeDefinition [Name] InputValueDefinition)))
-> Value
-> Parser
     (FromIntrospection (TypeDefinition [Name] InputValueDefinition))
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"TypeDefinition" ((Object
  -> Parser
       (FromIntrospection (TypeDefinition [Name] InputValueDefinition)))
 -> Value
 -> Parser
      (FromIntrospection (TypeDefinition [Name] InputValueDefinition)))
-> (Object
    -> Parser
         (FromIntrospection (TypeDefinition [Name] InputValueDefinition)))
-> Value
-> Parser
     (FromIntrospection (TypeDefinition [Name] InputValueDefinition))
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
kind :: Text <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind"
    TypeDefinition [Name] InputValueDefinition
r <- case Text
kind of
      Text
"SCALAR" ->
        ScalarTypeDefinition -> TypeDefinition [Name] InputValueDefinition
forall possibleTypes inputType.
ScalarTypeDefinition -> TypeDefinition possibleTypes inputType
G.TypeDefinitionScalar (ScalarTypeDefinition
 -> TypeDefinition [Name] InputValueDefinition)
-> (FromIntrospection ScalarTypeDefinition -> ScalarTypeDefinition)
-> FromIntrospection ScalarTypeDefinition
-> TypeDefinition [Name] InputValueDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromIntrospection ScalarTypeDefinition -> ScalarTypeDefinition
forall a. FromIntrospection a -> a
fromIntrospection (FromIntrospection ScalarTypeDefinition
 -> TypeDefinition [Name] InputValueDefinition)
-> Parser (FromIntrospection ScalarTypeDefinition)
-> Parser (TypeDefinition [Name] InputValueDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (FromIntrospection ScalarTypeDefinition)
forall a. FromJSON a => Value -> Parser a
J.parseJSON (Object -> Value
J.Object Object
o)
      Text
"OBJECT" ->
        ObjectTypeDefinition InputValueDefinition
-> TypeDefinition [Name] InputValueDefinition
forall possibleTypes inputType.
ObjectTypeDefinition inputType
-> TypeDefinition possibleTypes inputType
G.TypeDefinitionObject (ObjectTypeDefinition InputValueDefinition
 -> TypeDefinition [Name] InputValueDefinition)
-> (FromIntrospection (ObjectTypeDefinition InputValueDefinition)
    -> ObjectTypeDefinition InputValueDefinition)
-> FromIntrospection (ObjectTypeDefinition InputValueDefinition)
-> TypeDefinition [Name] InputValueDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromIntrospection (ObjectTypeDefinition InputValueDefinition)
-> ObjectTypeDefinition InputValueDefinition
forall a. FromIntrospection a -> a
fromIntrospection (FromIntrospection (ObjectTypeDefinition InputValueDefinition)
 -> TypeDefinition [Name] InputValueDefinition)
-> Parser
     (FromIntrospection (ObjectTypeDefinition InputValueDefinition))
-> Parser (TypeDefinition [Name] InputValueDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
-> Parser
     (FromIntrospection (ObjectTypeDefinition InputValueDefinition))
forall a. FromJSON a => Value -> Parser a
J.parseJSON (Object -> Value
J.Object Object
o)
      Text
"INTERFACE" ->
        InterfaceTypeDefinition [Name] InputValueDefinition
-> TypeDefinition [Name] InputValueDefinition
forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType
-> TypeDefinition possibleTypes inputType
G.TypeDefinitionInterface (InterfaceTypeDefinition [Name] InputValueDefinition
 -> TypeDefinition [Name] InputValueDefinition)
-> (FromIntrospection
      (InterfaceTypeDefinition [Name] InputValueDefinition)
    -> InterfaceTypeDefinition [Name] InputValueDefinition)
-> FromIntrospection
     (InterfaceTypeDefinition [Name] InputValueDefinition)
-> TypeDefinition [Name] InputValueDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromIntrospection
  (InterfaceTypeDefinition [Name] InputValueDefinition)
-> InterfaceTypeDefinition [Name] InputValueDefinition
forall a. FromIntrospection a -> a
fromIntrospection (FromIntrospection
   (InterfaceTypeDefinition [Name] InputValueDefinition)
 -> TypeDefinition [Name] InputValueDefinition)
-> Parser
     (FromIntrospection
        (InterfaceTypeDefinition [Name] InputValueDefinition))
-> Parser (TypeDefinition [Name] InputValueDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
-> Parser
     (FromIntrospection
        (InterfaceTypeDefinition [Name] InputValueDefinition))
forall a. FromJSON a => Value -> Parser a
J.parseJSON (Object -> Value
J.Object Object
o)
      Text
"UNION" ->
        UnionTypeDefinition -> TypeDefinition [Name] InputValueDefinition
forall possibleTypes inputType.
UnionTypeDefinition -> TypeDefinition possibleTypes inputType
G.TypeDefinitionUnion (UnionTypeDefinition -> TypeDefinition [Name] InputValueDefinition)
-> (FromIntrospection UnionTypeDefinition -> UnionTypeDefinition)
-> FromIntrospection UnionTypeDefinition
-> TypeDefinition [Name] InputValueDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromIntrospection UnionTypeDefinition -> UnionTypeDefinition
forall a. FromIntrospection a -> a
fromIntrospection (FromIntrospection UnionTypeDefinition
 -> TypeDefinition [Name] InputValueDefinition)
-> Parser (FromIntrospection UnionTypeDefinition)
-> Parser (TypeDefinition [Name] InputValueDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (FromIntrospection UnionTypeDefinition)
forall a. FromJSON a => Value -> Parser a
J.parseJSON (Object -> Value
J.Object Object
o)
      Text
"ENUM" ->
        EnumTypeDefinition -> TypeDefinition [Name] InputValueDefinition
forall possibleTypes inputType.
EnumTypeDefinition -> TypeDefinition possibleTypes inputType
G.TypeDefinitionEnum (EnumTypeDefinition -> TypeDefinition [Name] InputValueDefinition)
-> (FromIntrospection EnumTypeDefinition -> EnumTypeDefinition)
-> FromIntrospection EnumTypeDefinition
-> TypeDefinition [Name] InputValueDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromIntrospection EnumTypeDefinition -> EnumTypeDefinition
forall a. FromIntrospection a -> a
fromIntrospection (FromIntrospection EnumTypeDefinition
 -> TypeDefinition [Name] InputValueDefinition)
-> Parser (FromIntrospection EnumTypeDefinition)
-> Parser (TypeDefinition [Name] InputValueDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (FromIntrospection EnumTypeDefinition)
forall a. FromJSON a => Value -> Parser a
J.parseJSON (Object -> Value
J.Object Object
o)
      Text
"INPUT_OBJECT" ->
        InputObjectTypeDefinition InputValueDefinition
-> TypeDefinition [Name] InputValueDefinition
forall possibleTypes inputType.
InputObjectTypeDefinition inputType
-> TypeDefinition possibleTypes inputType
G.TypeDefinitionInputObject (InputObjectTypeDefinition InputValueDefinition
 -> TypeDefinition [Name] InputValueDefinition)
-> (FromIntrospection
      (InputObjectTypeDefinition InputValueDefinition)
    -> InputObjectTypeDefinition InputValueDefinition)
-> FromIntrospection
     (InputObjectTypeDefinition InputValueDefinition)
-> TypeDefinition [Name] InputValueDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromIntrospection (InputObjectTypeDefinition InputValueDefinition)
-> InputObjectTypeDefinition InputValueDefinition
forall a. FromIntrospection a -> a
fromIntrospection (FromIntrospection (InputObjectTypeDefinition InputValueDefinition)
 -> TypeDefinition [Name] InputValueDefinition)
-> Parser
     (FromIntrospection
        (InputObjectTypeDefinition InputValueDefinition))
-> Parser (TypeDefinition [Name] InputValueDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
-> Parser
     (FromIntrospection
        (InputObjectTypeDefinition InputValueDefinition))
forall a. FromJSON a => Value -> Parser a
J.parseJSON (Object -> Value
J.Object Object
o)
      Text
_ -> Text -> Parser (TypeDefinition [Name] InputValueDefinition)
forall (m :: * -> *) a. MonadFail m => Text -> m a
pErr (Text -> Parser (TypeDefinition [Name] InputValueDefinition))
-> Text -> Parser (TypeDefinition [Name] InputValueDefinition)
forall a b. (a -> b) -> a -> b
$ Text
"unknown kind: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
kind
    FromIntrospection (TypeDefinition [Name] InputValueDefinition)
-> Parser
     (FromIntrospection (TypeDefinition [Name] InputValueDefinition))
forall (m :: * -> *) a. Monad m => a -> m a
return (FromIntrospection (TypeDefinition [Name] InputValueDefinition)
 -> Parser
      (FromIntrospection (TypeDefinition [Name] InputValueDefinition)))
-> FromIntrospection (TypeDefinition [Name] InputValueDefinition)
-> Parser
     (FromIntrospection (TypeDefinition [Name] InputValueDefinition))
forall a b. (a -> b) -> a -> b
$ TypeDefinition [Name] InputValueDefinition
-> FromIntrospection (TypeDefinition [Name] InputValueDefinition)
forall a. a -> FromIntrospection a
FromIntrospection TypeDefinition [Name] InputValueDefinition
r

instance J.FromJSON (FromIntrospection IntrospectionResult) where
  parseJSON :: Value -> Parser (FromIntrospection IntrospectionResult)
parseJSON = String
-> (Object -> Parser (FromIntrospection IntrospectionResult))
-> Value
-> Parser (FromIntrospection IntrospectionResult)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"SchemaDocument" ((Object -> Parser (FromIntrospection IntrospectionResult))
 -> Value -> Parser (FromIntrospection IntrospectionResult))
-> (Object -> Parser (FromIntrospection IntrospectionResult))
-> Value
-> Parser (FromIntrospection IntrospectionResult)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
_data <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
    Object
schema <- Object
_data Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"__schema"
    -- the list of types
    [FromIntrospection (TypeDefinition [Name] InputValueDefinition)]
types <- Object
schema Object
-> Key
-> Parser
     [FromIntrospection (TypeDefinition [Name] InputValueDefinition)]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"types"
    -- query root
    Object
queryType <- Object
schema Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"queryType"
    Name
queryRoot <- Object
queryType Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    -- mutation root
    Maybe Object
mMutationType <- Object
schema Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mutationType"
    Maybe Name
mutationRoot <- case Maybe Object
mMutationType of
      Maybe Object
Nothing -> Maybe Name -> Parser (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing
      Just Object
mutType -> do
        Name
mutRoot <- Object
mutType Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
        Maybe Name -> Parser (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name -> Parser (Maybe Name))
-> Maybe Name -> Parser (Maybe Name)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name
forall a. a -> Maybe a
Just Name
mutRoot
    -- subscription root
    Maybe Object
mSubsType <- Object
schema Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subscriptionType"
    Maybe Name
subsRoot <- case Maybe Object
mSubsType of
      Maybe Object
Nothing -> Maybe Name -> Parser (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing
      Just Object
subsType -> do
        Name
subRoot <- Object
subsType Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
        Maybe Name -> Parser (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Name -> Parser (Maybe Name))
-> Maybe Name -> Parser (Maybe Name)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name
forall a. a -> Maybe a
Just Name
subRoot
    let types' :: [FromIntrospection
   (TypeDefinition [Name] RemoteSchemaInputValueDefinition)]
types' =
          ((FromIntrospection (TypeDefinition [Name] InputValueDefinition)
 -> FromIntrospection
      (TypeDefinition [Name] RemoteSchemaInputValueDefinition))
-> [FromIntrospection (TypeDefinition [Name] InputValueDefinition)]
-> [FromIntrospection
      (TypeDefinition [Name] RemoteSchemaInputValueDefinition)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FromIntrospection (TypeDefinition [Name] InputValueDefinition)
  -> FromIntrospection
       (TypeDefinition [Name] RemoteSchemaInputValueDefinition))
 -> [FromIntrospection (TypeDefinition [Name] InputValueDefinition)]
 -> [FromIntrospection
       (TypeDefinition [Name] RemoteSchemaInputValueDefinition)])
-> ((InputValueDefinition -> RemoteSchemaInputValueDefinition)
    -> FromIntrospection (TypeDefinition [Name] InputValueDefinition)
    -> FromIntrospection
         (TypeDefinition [Name] RemoteSchemaInputValueDefinition))
-> (InputValueDefinition -> RemoteSchemaInputValueDefinition)
-> [FromIntrospection (TypeDefinition [Name] InputValueDefinition)]
-> [FromIntrospection
      (TypeDefinition [Name] RemoteSchemaInputValueDefinition)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeDefinition [Name] InputValueDefinition
 -> TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> FromIntrospection (TypeDefinition [Name] InputValueDefinition)
-> FromIntrospection
     (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TypeDefinition [Name] InputValueDefinition
  -> TypeDefinition [Name] RemoteSchemaInputValueDefinition)
 -> FromIntrospection (TypeDefinition [Name] InputValueDefinition)
 -> FromIntrospection
      (TypeDefinition [Name] RemoteSchemaInputValueDefinition))
-> ((InputValueDefinition -> RemoteSchemaInputValueDefinition)
    -> TypeDefinition [Name] InputValueDefinition
    -> TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> (InputValueDefinition -> RemoteSchemaInputValueDefinition)
-> FromIntrospection (TypeDefinition [Name] InputValueDefinition)
-> FromIntrospection
     (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InputValueDefinition -> RemoteSchemaInputValueDefinition)
-> TypeDefinition [Name] InputValueDefinition
-> TypeDefinition [Name] RemoteSchemaInputValueDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap)
            -- presets are only defined for non-admin roles,
            -- an admin will not have any presets
            -- defined and the admin will be the one,
            -- who'll be adding the remote schema,
            -- hence presets are set to `Nothing`
            (InputValueDefinition
-> Maybe (Value RemoteSchemaVariable)
-> RemoteSchemaInputValueDefinition
`RemoteSchemaInputValueDefinition` Maybe (Value RemoteSchemaVariable)
forall a. Maybe a
Nothing)
            [FromIntrospection (TypeDefinition [Name] InputValueDefinition)]
types
        r :: IntrospectionResult
r =
          RemoteSchemaIntrospection
-> Name -> Maybe Name -> Maybe Name -> IntrospectionResult
IntrospectionResult
            (HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> RemoteSchemaIntrospection
RemoteSchemaIntrospection (HashMap
   Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
 -> RemoteSchemaIntrospection)
-> HashMap
     Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> RemoteSchemaIntrospection
forall a b. (a -> b) -> a -> b
$ (TypeDefinition [Name] RemoteSchemaInputValueDefinition -> Name)
-> [TypeDefinition [Name] RemoteSchemaInputValueDefinition]
-> HashMap
     Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall k v. (Eq k, Hashable k) => (v -> k) -> [v] -> HashMap k v
Map.fromListOn TypeDefinition [Name] RemoteSchemaInputValueDefinition -> Name
forall possibleTypes inputType.
TypeDefinition possibleTypes inputType -> Name
getTypeName ([TypeDefinition [Name] RemoteSchemaInputValueDefinition]
 -> HashMap
      Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition))
-> [TypeDefinition [Name] RemoteSchemaInputValueDefinition]
-> HashMap
     Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall a b. (a -> b) -> a -> b
$ FromIntrospection
  (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> TypeDefinition [Name] RemoteSchemaInputValueDefinition
forall a. FromIntrospection a -> a
fromIntrospection (FromIntrospection
   (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
 -> TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> [FromIntrospection
      (TypeDefinition [Name] RemoteSchemaInputValueDefinition)]
-> [TypeDefinition [Name] RemoteSchemaInputValueDefinition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FromIntrospection
   (TypeDefinition [Name] RemoteSchemaInputValueDefinition)]
types')
            Name
queryRoot
            Maybe Name
mutationRoot
            Maybe Name
subsRoot
    FromIntrospection IntrospectionResult
-> Parser (FromIntrospection IntrospectionResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (FromIntrospection IntrospectionResult
 -> Parser (FromIntrospection IntrospectionResult))
-> FromIntrospection IntrospectionResult
-> Parser (FromIntrospection IntrospectionResult)
forall a b. (a -> b) -> a -> b
$ IntrospectionResult -> FromIntrospection IntrospectionResult
forall a. a -> FromIntrospection a
FromIntrospection IntrospectionResult
r

-------------------------------------------------------------------------------
-- Customization

getCustomizer :: IntrospectionResult -> Maybe RemoteSchemaCustomization -> RemoteSchemaCustomizer
getCustomizer :: IntrospectionResult
-> Maybe RemoteSchemaCustomization -> RemoteSchemaCustomizer
getCustomizer IntrospectionResult
_ Maybe RemoteSchemaCustomization
Nothing = RemoteSchemaCustomizer
identityCustomizer
getCustomizer IntrospectionResult {Maybe Name
Name
RemoteSchemaIntrospection
irSubscriptionRoot :: Maybe Name
irMutationRoot :: Maybe Name
irQueryRoot :: Name
irDoc :: RemoteSchemaIntrospection
irSubscriptionRoot :: IntrospectionResult -> Maybe Name
irMutationRoot :: IntrospectionResult -> Maybe Name
irQueryRoot :: IntrospectionResult -> Name
irDoc :: IntrospectionResult -> RemoteSchemaIntrospection
..} (Just RemoteSchemaCustomization {Maybe [RemoteFieldCustomization]
Maybe Name
Maybe RemoteTypeCustomization
_rscFieldNames :: RemoteSchemaCustomization -> Maybe [RemoteFieldCustomization]
_rscTypeNames :: RemoteSchemaCustomization -> Maybe RemoteTypeCustomization
_rscRootFieldsNamespace :: RemoteSchemaCustomization -> Maybe Name
_rscFieldNames :: Maybe [RemoteFieldCustomization]
_rscTypeNames :: Maybe RemoteTypeCustomization
_rscRootFieldsNamespace :: Maybe Name
..}) = RemoteSchemaCustomizer :: Maybe Name
-> HashMap Name Name
-> HashMap Name (HashMap Name Name)
-> RemoteSchemaCustomizer
RemoteSchemaCustomizer {Maybe Name
HashMap Name (HashMap Name Name)
HashMap Name Name
_rscCustomizeFieldName :: HashMap Name (HashMap Name Name)
_rscCustomizeTypeName :: HashMap Name Name
_rscNamespaceFieldName :: Maybe Name
_rscCustomizeFieldName :: HashMap Name (HashMap Name Name)
_rscCustomizeTypeName :: HashMap Name Name
_rscNamespaceFieldName :: Maybe Name
..}
  where
    rootTypeNames :: HashSet Name
rootTypeNames =
      if Maybe Name -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Name
_rscRootFieldsNamespace
        then [Name] -> HashSet Name
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList ([Name] -> HashSet Name) -> [Name] -> HashSet Name
forall a b. (a -> b) -> a -> b
$ [Maybe Name] -> [Name]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Name -> Maybe Name
forall a. a -> Maybe a
Just Name
irQueryRoot, Maybe Name
irMutationRoot, Maybe Name
irSubscriptionRoot]
        else HashSet Name
forall a. Monoid a => a
mempty
    -- root type names should not be prefixed or suffixed unless
    -- there is a custom root namespace field
    protectedTypeNames :: HashSet Name
protectedTypeNames = HashSet Name
GName.builtInScalars HashSet Name -> HashSet Name -> HashSet Name
forall a. Semigroup a => a -> a -> a
<> HashSet Name
rootTypeNames
    nameFilter :: Name -> Bool
nameFilter Name
name = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"__" Text -> Text -> Bool
`T.isPrefixOf` Name -> Text
G.unName Name
name Bool -> Bool -> Bool
|| Name
name Name -> HashSet Name -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` HashSet Name
protectedTypeNames

    mkPrefixSuffixMap :: Maybe G.Name -> Maybe G.Name -> [G.Name] -> HashMap G.Name G.Name
    mkPrefixSuffixMap :: Maybe Name -> Maybe Name -> [Name] -> HashMap Name Name
mkPrefixSuffixMap Maybe Name
mPrefix Maybe Name
mSuffix [Name]
names = [(Name, Name)] -> HashMap Name Name
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Name, Name)] -> HashMap Name Name)
-> [(Name, Name)] -> HashMap Name Name
forall a b. (a -> b) -> a -> b
$ case (Maybe Name
mPrefix, Maybe Name
mSuffix) of
      (Maybe Name
Nothing, Maybe Name
Nothing) -> []
      (Just Name
prefix, Maybe Name
Nothing) -> (Name -> (Name, Name)) -> [Name] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> (Name
name, Name
prefix Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
name)) [Name]
names
      (Maybe Name
Nothing, Just Name
suffix) -> (Name -> (Name, Name)) -> [Name] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> (Name
name, Name
name Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
suffix)) [Name]
names
      (Just Name
prefix, Just Name
suffix) -> (Name -> (Name, Name)) -> [Name] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> (Name
name, Name
prefix Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
name Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
suffix)) [Name]
names

    RemoteSchemaIntrospection HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
typeDefinitions = RemoteSchemaIntrospection
irDoc
    typesToRename :: [Name]
typesToRename = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
nameFilter ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> [Name]
forall k v. HashMap k v -> [k]
Map.keys HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
typeDefinitions

    -- NOTE: We are creating a root type name mapping, this will be used to
    -- prefix the root field names with the root field namespace. We are doing
    -- this inorder to reduce typename conflicts while adding the root field
    -- namespace. Please note that this will have lower precedence order than
    -- the _rtcMapping. This means that a user can still change the root type
    -- name.
    rootTypeNameMap :: HashMap Name Name
rootTypeNameMap =
      Maybe Name -> Maybe Name -> [Name] -> HashMap Name Name
mkPrefixSuffixMap Maybe Name
_rscRootFieldsNamespace Maybe Name
forall a. Maybe a
Nothing ([Name] -> HashMap Name Name) -> [Name] -> HashMap Name Name
forall a b. (a -> b) -> a -> b
$
        [Maybe Name] -> [Name]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Name -> Maybe Name
forall a. a -> Maybe a
Just Name
irQueryRoot, Maybe Name
irMutationRoot, Maybe Name
irSubscriptionRoot]

    typeRenameMap :: HashMap Name Name
typeRenameMap =
      case Maybe RemoteTypeCustomization
_rscTypeNames of
        Maybe RemoteTypeCustomization
Nothing -> HashMap Name Name
rootTypeNameMap
        Just RemoteTypeCustomization {Maybe Name
HashMap Name Name
_rtcMapping :: RemoteTypeCustomization -> HashMap Name Name
_rtcSuffix :: RemoteTypeCustomization -> Maybe Name
_rtcPrefix :: RemoteTypeCustomization -> Maybe Name
_rtcMapping :: HashMap Name Name
_rtcSuffix :: Maybe Name
_rtcPrefix :: Maybe Name
..} ->
          HashMap Name Name
_rtcMapping HashMap Name Name -> HashMap Name Name -> HashMap Name Name
forall a. Semigroup a => a -> a -> a
<> HashMap Name Name
rootTypeNameMap HashMap Name Name -> HashMap Name Name -> HashMap Name Name
forall a. Semigroup a => a -> a -> a
<> Maybe Name -> Maybe Name -> [Name] -> HashMap Name Name
mkPrefixSuffixMap Maybe Name
_rtcPrefix Maybe Name
_rtcSuffix [Name]
typesToRename

    typeFieldMap :: HashMap G.Name [G.Name] -- typeName -> fieldNames
    typeFieldMap :: HashMap Name [Name]
typeFieldMap =
      (TypeDefinition [Name] RemoteSchemaInputValueDefinition
 -> Maybe [Name])
-> HashMap
     Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> HashMap Name [Name]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe TypeDefinition [Name] RemoteSchemaInputValueDefinition
-> Maybe [Name]
forall possibleTypes inputType.
TypeDefinition possibleTypes inputType -> Maybe [Name]
getFieldsNames HashMap
  Name (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
typeDefinitions
      where
        getFieldsNames :: TypeDefinition possibleTypes inputType -> Maybe [Name]
getFieldsNames = \case
          G.TypeDefinitionObject G.ObjectTypeDefinition {[Directive Void]
[FieldDefinition inputType]
[Name]
Maybe Description
Name
_otdFieldsDefinition :: [FieldDefinition inputType]
_otdDirectives :: [Directive Void]
_otdImplementsInterfaces :: [Name]
_otdName :: Name
_otdDescription :: Maybe Description
_otdName :: forall inputType. ObjectTypeDefinition inputType -> Name
_otdImplementsInterfaces :: forall inputType. ObjectTypeDefinition inputType -> [Name]
_otdFieldsDefinition :: forall inputType.
ObjectTypeDefinition inputType -> [FieldDefinition inputType]
_otdDirectives :: forall inputType.
ObjectTypeDefinition inputType -> [Directive Void]
_otdDescription :: forall inputType.
ObjectTypeDefinition inputType -> Maybe Description
..} -> [Name] -> Maybe [Name]
forall a. a -> Maybe a
Just ([Name] -> Maybe [Name]) -> [Name] -> Maybe [Name]
forall a b. (a -> b) -> a -> b
$ FieldDefinition inputType -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName (FieldDefinition inputType -> Name)
-> [FieldDefinition inputType] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldDefinition inputType]
_otdFieldsDefinition
          G.TypeDefinitionInterface G.InterfaceTypeDefinition {possibleTypes
[Directive Void]
[FieldDefinition inputType]
Maybe Description
Name
_itdPossibleTypes :: possibleTypes
_itdFieldsDefinition :: [FieldDefinition inputType]
_itdDirectives :: [Directive Void]
_itdName :: Name
_itdDescription :: Maybe Description
_itdPossibleTypes :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> possibleTypes
_itdName :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> Name
_itdFieldsDefinition :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType
-> [FieldDefinition inputType]
_itdDirectives :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType -> [Directive Void]
_itdDescription :: forall possibleTypes inputType.
InterfaceTypeDefinition possibleTypes inputType
-> Maybe Description
..} -> [Name] -> Maybe [Name]
forall a. a -> Maybe a
Just ([Name] -> Maybe [Name]) -> [Name] -> Maybe [Name]
forall a b. (a -> b) -> a -> b
$ FieldDefinition inputType -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName (FieldDefinition inputType -> Name)
-> [FieldDefinition inputType] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldDefinition inputType]
_itdFieldsDefinition
          TypeDefinition possibleTypes inputType
_ -> Maybe [Name]
forall a. Maybe a
Nothing

    mkFieldRenameMap :: RemoteFieldCustomization -> [Name] -> HashMap Name Name
mkFieldRenameMap RemoteFieldCustomization {Maybe Name
HashMap Name Name
Name
_rfcMapping :: RemoteFieldCustomization -> HashMap Name Name
_rfcSuffix :: RemoteFieldCustomization -> Maybe Name
_rfcPrefix :: RemoteFieldCustomization -> Maybe Name
_rfcParentType :: RemoteFieldCustomization -> Name
_rfcMapping :: HashMap Name Name
_rfcSuffix :: Maybe Name
_rfcPrefix :: Maybe Name
_rfcParentType :: Name
..} [Name]
fieldNames =
      HashMap Name Name
_rfcMapping HashMap Name Name -> HashMap Name Name -> HashMap Name Name
forall a. Semigroup a => a -> a -> a
<> Maybe Name -> Maybe Name -> [Name] -> HashMap Name Name
mkPrefixSuffixMap Maybe Name
_rfcPrefix Maybe Name
_rfcSuffix [Name]
fieldNames

    fieldRenameMap :: HashMap Name (HashMap Name Name)
fieldRenameMap =
      case Maybe [RemoteFieldCustomization]
_rscFieldNames of
        Maybe [RemoteFieldCustomization]
Nothing -> HashMap Name (HashMap Name Name)
forall k v. HashMap k v
Map.empty
        Just [RemoteFieldCustomization]
fieldNameCustomizations ->
          let customizationMap :: HashMap Name RemoteFieldCustomization
customizationMap = [(Name, RemoteFieldCustomization)]
-> HashMap Name RemoteFieldCustomization
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(Name, RemoteFieldCustomization)]
 -> HashMap Name RemoteFieldCustomization)
-> [(Name, RemoteFieldCustomization)]
-> HashMap Name RemoteFieldCustomization
forall a b. (a -> b) -> a -> b
$ (RemoteFieldCustomization -> (Name, RemoteFieldCustomization))
-> [RemoteFieldCustomization] -> [(Name, RemoteFieldCustomization)]
forall a b. (a -> b) -> [a] -> [b]
map (\RemoteFieldCustomization
rfc -> (RemoteFieldCustomization -> Name
_rfcParentType RemoteFieldCustomization
rfc, RemoteFieldCustomization
rfc)) [RemoteFieldCustomization]
fieldNameCustomizations
           in (RemoteFieldCustomization -> [Name] -> HashMap Name Name)
-> HashMap Name RemoteFieldCustomization
-> HashMap Name [Name]
-> HashMap Name (HashMap Name Name)
forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
Map.intersectionWith RemoteFieldCustomization -> [Name] -> HashMap Name Name
mkFieldRenameMap HashMap Name RemoteFieldCustomization
customizationMap HashMap Name [Name]
typeFieldMap

    _rscNamespaceFieldName :: Maybe Name
_rscNamespaceFieldName = Maybe Name
_rscRootFieldsNamespace
    _rscCustomizeTypeName :: HashMap Name Name
_rscCustomizeTypeName = HashMap Name Name
typeRenameMap
    _rscCustomizeFieldName :: HashMap Name (HashMap Name Name)
_rscCustomizeFieldName = HashMap Name (HashMap Name Name)
fieldRenameMap

------------------------------------------------------------------------------
-- Local error handling

pErr :: (MonadFail m) => Text -> m a
pErr :: Text -> m a
pErr = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> (Text -> String) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

kindErr :: (MonadFail m) => Text -> Text -> m a
kindErr :: Text -> Text -> m a
kindErr Text
gKind Text
eKind = Text -> m a
forall (m :: * -> *) a. MonadFail m => Text -> m a
pErr (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ Text
"Invalid `kind: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gKind Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
eKind

throwRemoteSchema :: QErrM m => Text -> m a
throwRemoteSchema :: Text -> m a
throwRemoteSchema = Code -> Text -> m a
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError

throwRemoteSchemaHttp ::
  QErrM m =>
  EnvRecord URI ->
  HTTP.HttpException ->
  m a
throwRemoteSchemaHttp :: EnvRecord URI -> HttpException -> m a
throwRemoteSchemaHttp EnvRecord URI
urlEnvRecord HttpException
exception =
  QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (QErr -> m a) -> QErr -> m a
forall a b. (a -> b) -> a -> b
$
    (EnvRecord URI -> QErr
forall a. EnvRecord a -> QErr
baseError EnvRecord URI
urlEnvRecord)
      { qeInternal :: Maybe QErrExtra
qeInternal = QErrExtra -> Maybe QErrExtra
forall a. a -> Maybe a
Just (QErrExtra -> Maybe QErrExtra) -> QErrExtra -> Maybe QErrExtra
forall a b. (a -> b) -> a -> b
$ Value -> QErrExtra
ExtraInternal (Value -> QErrExtra) -> Value -> QErrExtra
forall a b. (a -> b) -> a -> b
$ HttpException -> Value
forall a. ToJSON a => a -> Value
J.toJSON (HttpException -> Value) -> HttpException -> Value
forall a b. (a -> b) -> a -> b
$ HttpException -> HttpException
HttpException HttpException
exception
      }
  where
    baseError :: EnvRecord a -> QErr
baseError EnvRecord a
val = Code -> Text -> QErr
err400 Code
RemoteSchemaError (EnvRecord a -> Text
forall a. EnvRecord a -> Text
httpExceptMsg EnvRecord a
val)
    httpExceptMsg :: EnvRecord a -> Text
httpExceptMsg EnvRecord a
val = Text
"HTTP exception occurred while sending the request to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow (EnvRecord a -> Text
forall a. EnvRecord a -> Text
_envVarName EnvRecord a
val)