{-# 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.GetType
-- 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 a @Type@ object.
module Amazonka.AppSync.GetType
  ( -- * Creating a Request
    GetType (..),
    newGetType,

    -- * Request Lenses
    getType_apiId,
    getType_typeName,
    getType_format,

    -- * Destructuring the Response
    GetTypeResponse (..),
    newGetTypeResponse,

    -- * Response Lenses
    getTypeResponse_type,
    getTypeResponse_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:/ 'newGetType' smart constructor.
data GetType = GetType'
  { -- | The API ID.
    GetType -> Text
apiId :: Prelude.Text,
    -- | The type name.
    GetType -> Text
typeName :: Prelude.Text,
    -- | The type format: SDL or JSON.
    GetType -> TypeDefinitionFormat
format :: TypeDefinitionFormat
  }
  deriving (GetType -> GetType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetType -> GetType -> Bool
$c/= :: GetType -> GetType -> Bool
== :: GetType -> GetType -> Bool
$c== :: GetType -> GetType -> Bool
Prelude.Eq, ReadPrec [GetType]
ReadPrec GetType
Int -> ReadS GetType
ReadS [GetType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetType]
$creadListPrec :: ReadPrec [GetType]
readPrec :: ReadPrec GetType
$creadPrec :: ReadPrec GetType
readList :: ReadS [GetType]
$creadList :: ReadS [GetType]
readsPrec :: Int -> ReadS GetType
$creadsPrec :: Int -> ReadS GetType
Prelude.Read, Int -> GetType -> ShowS
[GetType] -> ShowS
GetType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetType] -> ShowS
$cshowList :: [GetType] -> ShowS
show :: GetType -> String
$cshow :: GetType -> String
showsPrec :: Int -> GetType -> ShowS
$cshowsPrec :: Int -> GetType -> ShowS
Prelude.Show, forall x. Rep GetType x -> GetType
forall x. GetType -> Rep GetType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetType x -> GetType
$cfrom :: forall x. GetType -> Rep GetType x
Prelude.Generic)

-- |
-- Create a value of 'GetType' 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:
--
-- 'apiId', 'getType_apiId' - The API ID.
--
-- 'typeName', 'getType_typeName' - The type name.
--
-- 'format', 'getType_format' - The type format: SDL or JSON.
newGetType ::
  -- | 'apiId'
  Prelude.Text ->
  -- | 'typeName'
  Prelude.Text ->
  -- | 'format'
  TypeDefinitionFormat ->
  GetType
newGetType :: Text -> Text -> TypeDefinitionFormat -> GetType
newGetType Text
pApiId_ Text
pTypeName_ TypeDefinitionFormat
pFormat_ =
  GetType'
    { $sel:apiId:GetType' :: Text
apiId = Text
pApiId_,
      $sel:typeName:GetType' :: Text
typeName = Text
pTypeName_,
      $sel:format:GetType' :: TypeDefinitionFormat
format = TypeDefinitionFormat
pFormat_
    }

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

-- | The type name.
getType_typeName :: Lens.Lens' GetType Prelude.Text
getType_typeName :: Lens' GetType Text
getType_typeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetType' {Text
typeName :: Text
$sel:typeName:GetType' :: GetType -> Text
typeName} -> Text
typeName) (\s :: GetType
s@GetType' {} Text
a -> GetType
s {$sel:typeName:GetType' :: Text
typeName = Text
a} :: GetType)

-- | The type format: SDL or JSON.
getType_format :: Lens.Lens' GetType TypeDefinitionFormat
getType_format :: Lens' GetType TypeDefinitionFormat
getType_format = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetType' {TypeDefinitionFormat
format :: TypeDefinitionFormat
$sel:format:GetType' :: GetType -> TypeDefinitionFormat
format} -> TypeDefinitionFormat
format) (\s :: GetType
s@GetType' {} TypeDefinitionFormat
a -> GetType
s {$sel:format:GetType' :: TypeDefinitionFormat
format = TypeDefinitionFormat
a} :: GetType)

instance Core.AWSRequest GetType where
  type AWSResponse GetType = GetTypeResponse
  request :: (Service -> Service) -> GetType -> Request GetType
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 GetType
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetType)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Type -> Int -> GetTypeResponse
GetTypeResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"type")
            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 GetType where
  hashWithSalt :: Int -> GetType -> Int
hashWithSalt Int
_salt GetType' {Text
TypeDefinitionFormat
format :: TypeDefinitionFormat
typeName :: Text
apiId :: Text
$sel:format:GetType' :: GetType -> TypeDefinitionFormat
$sel:typeName:GetType' :: GetType -> Text
$sel:apiId:GetType' :: GetType -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
typeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TypeDefinitionFormat
format

instance Prelude.NFData GetType where
  rnf :: GetType -> ()
rnf GetType' {Text
TypeDefinitionFormat
format :: TypeDefinitionFormat
typeName :: Text
apiId :: Text
$sel:format:GetType' :: GetType -> TypeDefinitionFormat
$sel:typeName:GetType' :: GetType -> Text
$sel:apiId:GetType' :: GetType -> Text
..} =
    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 Text
typeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TypeDefinitionFormat
format

instance Data.ToHeaders GetType where
  toHeaders :: GetType -> 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 GetType where
  toPath :: GetType -> ByteString
toPath GetType' {Text
TypeDefinitionFormat
format :: TypeDefinitionFormat
typeName :: Text
apiId :: Text
$sel:format:GetType' :: GetType -> TypeDefinitionFormat
$sel:typeName:GetType' :: GetType -> Text
$sel:apiId:GetType' :: GetType -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/apis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiId,
        ByteString
"/types/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
typeName
      ]

instance Data.ToQuery GetType where
  toQuery :: GetType -> QueryString
toQuery GetType' {Text
TypeDefinitionFormat
format :: TypeDefinitionFormat
typeName :: Text
apiId :: Text
$sel:format:GetType' :: GetType -> TypeDefinitionFormat
$sel:typeName:GetType' :: GetType -> Text
$sel:apiId:GetType' :: GetType -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"format" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: TypeDefinitionFormat
format]

-- | /See:/ 'newGetTypeResponse' smart constructor.
data GetTypeResponse = GetTypeResponse'
  { -- | The @Type@ object.
    GetTypeResponse -> Maybe Type
type' :: Prelude.Maybe Type,
    -- | The response's http status code.
    GetTypeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetTypeResponse -> GetTypeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTypeResponse -> GetTypeResponse -> Bool
$c/= :: GetTypeResponse -> GetTypeResponse -> Bool
== :: GetTypeResponse -> GetTypeResponse -> Bool
$c== :: GetTypeResponse -> GetTypeResponse -> Bool
Prelude.Eq, ReadPrec [GetTypeResponse]
ReadPrec GetTypeResponse
Int -> ReadS GetTypeResponse
ReadS [GetTypeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTypeResponse]
$creadListPrec :: ReadPrec [GetTypeResponse]
readPrec :: ReadPrec GetTypeResponse
$creadPrec :: ReadPrec GetTypeResponse
readList :: ReadS [GetTypeResponse]
$creadList :: ReadS [GetTypeResponse]
readsPrec :: Int -> ReadS GetTypeResponse
$creadsPrec :: Int -> ReadS GetTypeResponse
Prelude.Read, Int -> GetTypeResponse -> ShowS
[GetTypeResponse] -> ShowS
GetTypeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTypeResponse] -> ShowS
$cshowList :: [GetTypeResponse] -> ShowS
show :: GetTypeResponse -> String
$cshow :: GetTypeResponse -> String
showsPrec :: Int -> GetTypeResponse -> ShowS
$cshowsPrec :: Int -> GetTypeResponse -> ShowS
Prelude.Show, forall x. Rep GetTypeResponse x -> GetTypeResponse
forall x. GetTypeResponse -> Rep GetTypeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTypeResponse x -> GetTypeResponse
$cfrom :: forall x. GetTypeResponse -> Rep GetTypeResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetTypeResponse' 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:
--
-- 'type'', 'getTypeResponse_type' - The @Type@ object.
--
-- 'httpStatus', 'getTypeResponse_httpStatus' - The response's http status code.
newGetTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetTypeResponse
newGetTypeResponse :: Int -> GetTypeResponse
newGetTypeResponse Int
pHttpStatus_ =
  GetTypeResponse'
    { $sel:type':GetTypeResponse' :: Maybe Type
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetTypeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The @Type@ object.
getTypeResponse_type :: Lens.Lens' GetTypeResponse (Prelude.Maybe Type)
getTypeResponse_type :: Lens' GetTypeResponse (Maybe Type)
getTypeResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTypeResponse' {Maybe Type
type' :: Maybe Type
$sel:type':GetTypeResponse' :: GetTypeResponse -> Maybe Type
type'} -> Maybe Type
type') (\s :: GetTypeResponse
s@GetTypeResponse' {} Maybe Type
a -> GetTypeResponse
s {$sel:type':GetTypeResponse' :: Maybe Type
type' = Maybe Type
a} :: GetTypeResponse)

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

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