{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.AppSync.GetIntrospectionSchema
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the introspection schema for a GraphQL API.
module Amazonka.AppSync.GetIntrospectionSchema
  ( -- * Creating a Request
    GetIntrospectionSchema (..),
    newGetIntrospectionSchema,

    -- * Request Lenses
    getIntrospectionSchema_includeDirectives,
    getIntrospectionSchema_apiId,
    getIntrospectionSchema_format,

    -- * Destructuring the Response
    GetIntrospectionSchemaResponse (..),
    newGetIntrospectionSchemaResponse,

    -- * Response Lenses
    getIntrospectionSchemaResponse_schema,
    getIntrospectionSchemaResponse_httpStatus,
  )
where

import Amazonka.AppSync.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetIntrospectionSchema' smart constructor.
data GetIntrospectionSchema = GetIntrospectionSchema'
  { -- | A flag that specifies whether the schema introspection should contain
    -- directives.
    GetIntrospectionSchema -> Maybe Bool
includeDirectives :: Prelude.Maybe Prelude.Bool,
    -- | The API ID.
    GetIntrospectionSchema -> Text
apiId :: Prelude.Text,
    -- | The schema format: SDL or JSON.
    GetIntrospectionSchema -> OutputType
format :: OutputType
  }
  deriving (GetIntrospectionSchema -> GetIntrospectionSchema -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIntrospectionSchema -> GetIntrospectionSchema -> Bool
$c/= :: GetIntrospectionSchema -> GetIntrospectionSchema -> Bool
== :: GetIntrospectionSchema -> GetIntrospectionSchema -> Bool
$c== :: GetIntrospectionSchema -> GetIntrospectionSchema -> Bool
Prelude.Eq, ReadPrec [GetIntrospectionSchema]
ReadPrec GetIntrospectionSchema
Int -> ReadS GetIntrospectionSchema
ReadS [GetIntrospectionSchema]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetIntrospectionSchema]
$creadListPrec :: ReadPrec [GetIntrospectionSchema]
readPrec :: ReadPrec GetIntrospectionSchema
$creadPrec :: ReadPrec GetIntrospectionSchema
readList :: ReadS [GetIntrospectionSchema]
$creadList :: ReadS [GetIntrospectionSchema]
readsPrec :: Int -> ReadS GetIntrospectionSchema
$creadsPrec :: Int -> ReadS GetIntrospectionSchema
Prelude.Read, Int -> GetIntrospectionSchema -> ShowS
[GetIntrospectionSchema] -> ShowS
GetIntrospectionSchema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIntrospectionSchema] -> ShowS
$cshowList :: [GetIntrospectionSchema] -> ShowS
show :: GetIntrospectionSchema -> String
$cshow :: GetIntrospectionSchema -> String
showsPrec :: Int -> GetIntrospectionSchema -> ShowS
$cshowsPrec :: Int -> GetIntrospectionSchema -> ShowS
Prelude.Show, forall x. Rep GetIntrospectionSchema x -> GetIntrospectionSchema
forall x. GetIntrospectionSchema -> Rep GetIntrospectionSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetIntrospectionSchema x -> GetIntrospectionSchema
$cfrom :: forall x. GetIntrospectionSchema -> Rep GetIntrospectionSchema x
Prelude.Generic)

-- |
-- Create a value of 'GetIntrospectionSchema' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'includeDirectives', 'getIntrospectionSchema_includeDirectives' - A flag that specifies whether the schema introspection should contain
-- directives.
--
-- 'apiId', 'getIntrospectionSchema_apiId' - The API ID.
--
-- 'format', 'getIntrospectionSchema_format' - The schema format: SDL or JSON.
newGetIntrospectionSchema ::
  -- | 'apiId'
  Prelude.Text ->
  -- | 'format'
  OutputType ->
  GetIntrospectionSchema
newGetIntrospectionSchema :: Text -> OutputType -> GetIntrospectionSchema
newGetIntrospectionSchema Text
pApiId_ OutputType
pFormat_ =
  GetIntrospectionSchema'
    { $sel:includeDirectives:GetIntrospectionSchema' :: Maybe Bool
includeDirectives =
        forall a. Maybe a
Prelude.Nothing,
      $sel:apiId:GetIntrospectionSchema' :: Text
apiId = Text
pApiId_,
      $sel:format:GetIntrospectionSchema' :: OutputType
format = OutputType
pFormat_
    }

-- | A flag that specifies whether the schema introspection should contain
-- directives.
getIntrospectionSchema_includeDirectives :: Lens.Lens' GetIntrospectionSchema (Prelude.Maybe Prelude.Bool)
getIntrospectionSchema_includeDirectives :: Lens' GetIntrospectionSchema (Maybe Bool)
getIntrospectionSchema_includeDirectives = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIntrospectionSchema' {Maybe Bool
includeDirectives :: Maybe Bool
$sel:includeDirectives:GetIntrospectionSchema' :: GetIntrospectionSchema -> Maybe Bool
includeDirectives} -> Maybe Bool
includeDirectives) (\s :: GetIntrospectionSchema
s@GetIntrospectionSchema' {} Maybe Bool
a -> GetIntrospectionSchema
s {$sel:includeDirectives:GetIntrospectionSchema' :: Maybe Bool
includeDirectives = Maybe Bool
a} :: GetIntrospectionSchema)

-- | The API ID.
getIntrospectionSchema_apiId :: Lens.Lens' GetIntrospectionSchema Prelude.Text
getIntrospectionSchema_apiId :: Lens' GetIntrospectionSchema Text
getIntrospectionSchema_apiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIntrospectionSchema' {Text
apiId :: Text
$sel:apiId:GetIntrospectionSchema' :: GetIntrospectionSchema -> Text
apiId} -> Text
apiId) (\s :: GetIntrospectionSchema
s@GetIntrospectionSchema' {} Text
a -> GetIntrospectionSchema
s {$sel:apiId:GetIntrospectionSchema' :: Text
apiId = Text
a} :: GetIntrospectionSchema)

-- | The schema format: SDL or JSON.
getIntrospectionSchema_format :: Lens.Lens' GetIntrospectionSchema OutputType
getIntrospectionSchema_format :: Lens' GetIntrospectionSchema OutputType
getIntrospectionSchema_format = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIntrospectionSchema' {OutputType
format :: OutputType
$sel:format:GetIntrospectionSchema' :: GetIntrospectionSchema -> OutputType
format} -> OutputType
format) (\s :: GetIntrospectionSchema
s@GetIntrospectionSchema' {} OutputType
a -> GetIntrospectionSchema
s {$sel:format:GetIntrospectionSchema' :: OutputType
format = OutputType
a} :: GetIntrospectionSchema)

instance Core.AWSRequest GetIntrospectionSchema where
  type
    AWSResponse GetIntrospectionSchema =
      GetIntrospectionSchemaResponse
  request :: (Service -> Service)
-> GetIntrospectionSchema -> Request GetIntrospectionSchema
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetIntrospectionSchema
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetIntrospectionSchema)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders -> ByteString -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBytes
      ( \Int
s ResponseHeaders
h ByteString
x ->
          Maybe ByteString -> Int -> GetIntrospectionSchemaResponse
GetIntrospectionSchemaResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. a -> Maybe a
Prelude.Just (coerce :: forall a b. Coercible a b => a -> b
Prelude.coerce ByteString
x)))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetIntrospectionSchema where
  hashWithSalt :: Int -> GetIntrospectionSchema -> Int
hashWithSalt Int
_salt GetIntrospectionSchema' {Maybe Bool
Text
OutputType
format :: OutputType
apiId :: Text
includeDirectives :: Maybe Bool
$sel:format:GetIntrospectionSchema' :: GetIntrospectionSchema -> OutputType
$sel:apiId:GetIntrospectionSchema' :: GetIntrospectionSchema -> Text
$sel:includeDirectives:GetIntrospectionSchema' :: GetIntrospectionSchema -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeDirectives
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` OutputType
format

instance Prelude.NFData GetIntrospectionSchema where
  rnf :: GetIntrospectionSchema -> ()
rnf GetIntrospectionSchema' {Maybe Bool
Text
OutputType
format :: OutputType
apiId :: Text
includeDirectives :: Maybe Bool
$sel:format:GetIntrospectionSchema' :: GetIntrospectionSchema -> OutputType
$sel:apiId:GetIntrospectionSchema' :: GetIntrospectionSchema -> Text
$sel:includeDirectives:GetIntrospectionSchema' :: GetIntrospectionSchema -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeDirectives
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
apiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf OutputType
format

instance Data.ToHeaders GetIntrospectionSchema where
  toHeaders :: GetIntrospectionSchema -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetIntrospectionSchema where
  toPath :: GetIntrospectionSchema -> ByteString
toPath GetIntrospectionSchema' {Maybe Bool
Text
OutputType
format :: OutputType
apiId :: Text
includeDirectives :: Maybe Bool
$sel:format:GetIntrospectionSchema' :: GetIntrospectionSchema -> OutputType
$sel:apiId:GetIntrospectionSchema' :: GetIntrospectionSchema -> Text
$sel:includeDirectives:GetIntrospectionSchema' :: GetIntrospectionSchema -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/v1/apis/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiId, ByteString
"/schema"]

instance Data.ToQuery GetIntrospectionSchema where
  toQuery :: GetIntrospectionSchema -> QueryString
toQuery GetIntrospectionSchema' {Maybe Bool
Text
OutputType
format :: OutputType
apiId :: Text
includeDirectives :: Maybe Bool
$sel:format:GetIntrospectionSchema' :: GetIntrospectionSchema -> OutputType
$sel:apiId:GetIntrospectionSchema' :: GetIntrospectionSchema -> Text
$sel:includeDirectives:GetIntrospectionSchema' :: GetIntrospectionSchema -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"includeDirectives" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
includeDirectives,
        ByteString
"format" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: OutputType
format
      ]

-- | /See:/ 'newGetIntrospectionSchemaResponse' smart constructor.
data GetIntrospectionSchemaResponse = GetIntrospectionSchemaResponse'
  { -- | The schema, in GraphQL Schema Definition Language (SDL) format.
    --
    -- For more information, see the
    -- <http://graphql.org/learn/schema/ GraphQL SDL documentation>.
    GetIntrospectionSchemaResponse -> Maybe ByteString
schema :: Prelude.Maybe Prelude.ByteString,
    -- | The response's http status code.
    GetIntrospectionSchemaResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetIntrospectionSchemaResponse
-> GetIntrospectionSchemaResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetIntrospectionSchemaResponse
-> GetIntrospectionSchemaResponse -> Bool
$c/= :: GetIntrospectionSchemaResponse
-> GetIntrospectionSchemaResponse -> Bool
== :: GetIntrospectionSchemaResponse
-> GetIntrospectionSchemaResponse -> Bool
$c== :: GetIntrospectionSchemaResponse
-> GetIntrospectionSchemaResponse -> Bool
Prelude.Eq, ReadPrec [GetIntrospectionSchemaResponse]
ReadPrec GetIntrospectionSchemaResponse
Int -> ReadS GetIntrospectionSchemaResponse
ReadS [GetIntrospectionSchemaResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetIntrospectionSchemaResponse]
$creadListPrec :: ReadPrec [GetIntrospectionSchemaResponse]
readPrec :: ReadPrec GetIntrospectionSchemaResponse
$creadPrec :: ReadPrec GetIntrospectionSchemaResponse
readList :: ReadS [GetIntrospectionSchemaResponse]
$creadList :: ReadS [GetIntrospectionSchemaResponse]
readsPrec :: Int -> ReadS GetIntrospectionSchemaResponse
$creadsPrec :: Int -> ReadS GetIntrospectionSchemaResponse
Prelude.Read, Int -> GetIntrospectionSchemaResponse -> ShowS
[GetIntrospectionSchemaResponse] -> ShowS
GetIntrospectionSchemaResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetIntrospectionSchemaResponse] -> ShowS
$cshowList :: [GetIntrospectionSchemaResponse] -> ShowS
show :: GetIntrospectionSchemaResponse -> String
$cshow :: GetIntrospectionSchemaResponse -> String
showsPrec :: Int -> GetIntrospectionSchemaResponse -> ShowS
$cshowsPrec :: Int -> GetIntrospectionSchemaResponse -> ShowS
Prelude.Show, forall x.
Rep GetIntrospectionSchemaResponse x
-> GetIntrospectionSchemaResponse
forall x.
GetIntrospectionSchemaResponse
-> Rep GetIntrospectionSchemaResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetIntrospectionSchemaResponse x
-> GetIntrospectionSchemaResponse
$cfrom :: forall x.
GetIntrospectionSchemaResponse
-> Rep GetIntrospectionSchemaResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetIntrospectionSchemaResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'schema', 'getIntrospectionSchemaResponse_schema' - The schema, in GraphQL Schema Definition Language (SDL) format.
--
-- For more information, see the
-- <http://graphql.org/learn/schema/ GraphQL SDL documentation>.
--
-- 'httpStatus', 'getIntrospectionSchemaResponse_httpStatus' - The response's http status code.
newGetIntrospectionSchemaResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetIntrospectionSchemaResponse
newGetIntrospectionSchemaResponse :: Int -> GetIntrospectionSchemaResponse
newGetIntrospectionSchemaResponse Int
pHttpStatus_ =
  GetIntrospectionSchemaResponse'
    { $sel:schema:GetIntrospectionSchemaResponse' :: Maybe ByteString
schema =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetIntrospectionSchemaResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The schema, in GraphQL Schema Definition Language (SDL) format.
--
-- For more information, see the
-- <http://graphql.org/learn/schema/ GraphQL SDL documentation>.
getIntrospectionSchemaResponse_schema :: Lens.Lens' GetIntrospectionSchemaResponse (Prelude.Maybe Prelude.ByteString)
getIntrospectionSchemaResponse_schema :: Lens' GetIntrospectionSchemaResponse (Maybe ByteString)
getIntrospectionSchemaResponse_schema = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIntrospectionSchemaResponse' {Maybe ByteString
schema :: Maybe ByteString
$sel:schema:GetIntrospectionSchemaResponse' :: GetIntrospectionSchemaResponse -> Maybe ByteString
schema} -> Maybe ByteString
schema) (\s :: GetIntrospectionSchemaResponse
s@GetIntrospectionSchemaResponse' {} Maybe ByteString
a -> GetIntrospectionSchemaResponse
s {$sel:schema:GetIntrospectionSchemaResponse' :: Maybe ByteString
schema = Maybe ByteString
a} :: GetIntrospectionSchemaResponse)

-- | The response's http status code.
getIntrospectionSchemaResponse_httpStatus :: Lens.Lens' GetIntrospectionSchemaResponse Prelude.Int
getIntrospectionSchemaResponse_httpStatus :: Lens' GetIntrospectionSchemaResponse Int
getIntrospectionSchemaResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetIntrospectionSchemaResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetIntrospectionSchemaResponse' :: GetIntrospectionSchemaResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetIntrospectionSchemaResponse
s@GetIntrospectionSchemaResponse' {} Int
a -> GetIntrospectionSchemaResponse
s {$sel:httpStatus:GetIntrospectionSchemaResponse' :: Int
httpStatus = Int
a} :: GetIntrospectionSchemaResponse)

instance
  Prelude.NFData
    GetIntrospectionSchemaResponse
  where
  rnf :: GetIntrospectionSchemaResponse -> ()
rnf GetIntrospectionSchemaResponse' {Int
Maybe ByteString
httpStatus :: Int
schema :: Maybe ByteString
$sel:httpStatus:GetIntrospectionSchemaResponse' :: GetIntrospectionSchemaResponse -> Int
$sel:schema:GetIntrospectionSchemaResponse' :: GetIntrospectionSchemaResponse -> Maybe ByteString
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ByteString
schema
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus