{-# 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.AppFlow.DescribeConnectorEntity
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides details regarding the entity used with the connector, with a
-- description of the data model for each field in that entity.
module Amazonka.AppFlow.DescribeConnectorEntity
  ( -- * Creating a Request
    DescribeConnectorEntity (..),
    newDescribeConnectorEntity,

    -- * Request Lenses
    describeConnectorEntity_apiVersion,
    describeConnectorEntity_connectorProfileName,
    describeConnectorEntity_connectorType,
    describeConnectorEntity_connectorEntityName,

    -- * Destructuring the Response
    DescribeConnectorEntityResponse (..),
    newDescribeConnectorEntityResponse,

    -- * Response Lenses
    describeConnectorEntityResponse_httpStatus,
    describeConnectorEntityResponse_connectorEntityFields,
  )
where

import Amazonka.AppFlow.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:/ 'newDescribeConnectorEntity' smart constructor.
data DescribeConnectorEntity = DescribeConnectorEntity'
  { -- | The version of the API that\'s used by the connector.
    DescribeConnectorEntity -> Maybe Text
apiVersion :: Prelude.Maybe Prelude.Text,
    -- | The name of the connector profile. The name is unique for each
    -- @ConnectorProfile@ in the Amazon Web Services account.
    DescribeConnectorEntity -> Maybe Text
connectorProfileName :: Prelude.Maybe Prelude.Text,
    -- | The type of connector application, such as Salesforce, Amplitude, and so
    -- on.
    DescribeConnectorEntity -> Maybe ConnectorType
connectorType :: Prelude.Maybe ConnectorType,
    -- | The entity name for that connector.
    DescribeConnectorEntity -> Text
connectorEntityName :: Prelude.Text
  }
  deriving (DescribeConnectorEntity -> DescribeConnectorEntity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeConnectorEntity -> DescribeConnectorEntity -> Bool
$c/= :: DescribeConnectorEntity -> DescribeConnectorEntity -> Bool
== :: DescribeConnectorEntity -> DescribeConnectorEntity -> Bool
$c== :: DescribeConnectorEntity -> DescribeConnectorEntity -> Bool
Prelude.Eq, ReadPrec [DescribeConnectorEntity]
ReadPrec DescribeConnectorEntity
Int -> ReadS DescribeConnectorEntity
ReadS [DescribeConnectorEntity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeConnectorEntity]
$creadListPrec :: ReadPrec [DescribeConnectorEntity]
readPrec :: ReadPrec DescribeConnectorEntity
$creadPrec :: ReadPrec DescribeConnectorEntity
readList :: ReadS [DescribeConnectorEntity]
$creadList :: ReadS [DescribeConnectorEntity]
readsPrec :: Int -> ReadS DescribeConnectorEntity
$creadsPrec :: Int -> ReadS DescribeConnectorEntity
Prelude.Read, Int -> DescribeConnectorEntity -> ShowS
[DescribeConnectorEntity] -> ShowS
DescribeConnectorEntity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeConnectorEntity] -> ShowS
$cshowList :: [DescribeConnectorEntity] -> ShowS
show :: DescribeConnectorEntity -> String
$cshow :: DescribeConnectorEntity -> String
showsPrec :: Int -> DescribeConnectorEntity -> ShowS
$cshowsPrec :: Int -> DescribeConnectorEntity -> ShowS
Prelude.Show, forall x. Rep DescribeConnectorEntity x -> DescribeConnectorEntity
forall x. DescribeConnectorEntity -> Rep DescribeConnectorEntity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeConnectorEntity x -> DescribeConnectorEntity
$cfrom :: forall x. DescribeConnectorEntity -> Rep DescribeConnectorEntity x
Prelude.Generic)

-- |
-- Create a value of 'DescribeConnectorEntity' 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:
--
-- 'apiVersion', 'describeConnectorEntity_apiVersion' - The version of the API that\'s used by the connector.
--
-- 'connectorProfileName', 'describeConnectorEntity_connectorProfileName' - The name of the connector profile. The name is unique for each
-- @ConnectorProfile@ in the Amazon Web Services account.
--
-- 'connectorType', 'describeConnectorEntity_connectorType' - The type of connector application, such as Salesforce, Amplitude, and so
-- on.
--
-- 'connectorEntityName', 'describeConnectorEntity_connectorEntityName' - The entity name for that connector.
newDescribeConnectorEntity ::
  -- | 'connectorEntityName'
  Prelude.Text ->
  DescribeConnectorEntity
newDescribeConnectorEntity :: Text -> DescribeConnectorEntity
newDescribeConnectorEntity Text
pConnectorEntityName_ =
  DescribeConnectorEntity'
    { $sel:apiVersion:DescribeConnectorEntity' :: Maybe Text
apiVersion =
        forall a. Maybe a
Prelude.Nothing,
      $sel:connectorProfileName:DescribeConnectorEntity' :: Maybe Text
connectorProfileName = forall a. Maybe a
Prelude.Nothing,
      $sel:connectorType:DescribeConnectorEntity' :: Maybe ConnectorType
connectorType = forall a. Maybe a
Prelude.Nothing,
      $sel:connectorEntityName:DescribeConnectorEntity' :: Text
connectorEntityName = Text
pConnectorEntityName_
    }

-- | The version of the API that\'s used by the connector.
describeConnectorEntity_apiVersion :: Lens.Lens' DescribeConnectorEntity (Prelude.Maybe Prelude.Text)
describeConnectorEntity_apiVersion :: Lens' DescribeConnectorEntity (Maybe Text)
describeConnectorEntity_apiVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConnectorEntity' {Maybe Text
apiVersion :: Maybe Text
$sel:apiVersion:DescribeConnectorEntity' :: DescribeConnectorEntity -> Maybe Text
apiVersion} -> Maybe Text
apiVersion) (\s :: DescribeConnectorEntity
s@DescribeConnectorEntity' {} Maybe Text
a -> DescribeConnectorEntity
s {$sel:apiVersion:DescribeConnectorEntity' :: Maybe Text
apiVersion = Maybe Text
a} :: DescribeConnectorEntity)

-- | The name of the connector profile. The name is unique for each
-- @ConnectorProfile@ in the Amazon Web Services account.
describeConnectorEntity_connectorProfileName :: Lens.Lens' DescribeConnectorEntity (Prelude.Maybe Prelude.Text)
describeConnectorEntity_connectorProfileName :: Lens' DescribeConnectorEntity (Maybe Text)
describeConnectorEntity_connectorProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConnectorEntity' {Maybe Text
connectorProfileName :: Maybe Text
$sel:connectorProfileName:DescribeConnectorEntity' :: DescribeConnectorEntity -> Maybe Text
connectorProfileName} -> Maybe Text
connectorProfileName) (\s :: DescribeConnectorEntity
s@DescribeConnectorEntity' {} Maybe Text
a -> DescribeConnectorEntity
s {$sel:connectorProfileName:DescribeConnectorEntity' :: Maybe Text
connectorProfileName = Maybe Text
a} :: DescribeConnectorEntity)

-- | The type of connector application, such as Salesforce, Amplitude, and so
-- on.
describeConnectorEntity_connectorType :: Lens.Lens' DescribeConnectorEntity (Prelude.Maybe ConnectorType)
describeConnectorEntity_connectorType :: Lens' DescribeConnectorEntity (Maybe ConnectorType)
describeConnectorEntity_connectorType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConnectorEntity' {Maybe ConnectorType
connectorType :: Maybe ConnectorType
$sel:connectorType:DescribeConnectorEntity' :: DescribeConnectorEntity -> Maybe ConnectorType
connectorType} -> Maybe ConnectorType
connectorType) (\s :: DescribeConnectorEntity
s@DescribeConnectorEntity' {} Maybe ConnectorType
a -> DescribeConnectorEntity
s {$sel:connectorType:DescribeConnectorEntity' :: Maybe ConnectorType
connectorType = Maybe ConnectorType
a} :: DescribeConnectorEntity)

-- | The entity name for that connector.
describeConnectorEntity_connectorEntityName :: Lens.Lens' DescribeConnectorEntity Prelude.Text
describeConnectorEntity_connectorEntityName :: Lens' DescribeConnectorEntity Text
describeConnectorEntity_connectorEntityName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConnectorEntity' {Text
connectorEntityName :: Text
$sel:connectorEntityName:DescribeConnectorEntity' :: DescribeConnectorEntity -> Text
connectorEntityName} -> Text
connectorEntityName) (\s :: DescribeConnectorEntity
s@DescribeConnectorEntity' {} Text
a -> DescribeConnectorEntity
s {$sel:connectorEntityName:DescribeConnectorEntity' :: Text
connectorEntityName = Text
a} :: DescribeConnectorEntity)

instance Core.AWSRequest DescribeConnectorEntity where
  type
    AWSResponse DescribeConnectorEntity =
      DescribeConnectorEntityResponse
  request :: (Service -> Service)
-> DescribeConnectorEntity -> Request DescribeConnectorEntity
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeConnectorEntity
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeConnectorEntity)))
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 ->
          Int -> [ConnectorEntityField] -> DescribeConnectorEntityResponse
DescribeConnectorEntityResponse'
            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. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"connectorEntityFields"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable DescribeConnectorEntity where
  hashWithSalt :: Int -> DescribeConnectorEntity -> Int
hashWithSalt Int
_salt DescribeConnectorEntity' {Maybe Text
Maybe ConnectorType
Text
connectorEntityName :: Text
connectorType :: Maybe ConnectorType
connectorProfileName :: Maybe Text
apiVersion :: Maybe Text
$sel:connectorEntityName:DescribeConnectorEntity' :: DescribeConnectorEntity -> Text
$sel:connectorType:DescribeConnectorEntity' :: DescribeConnectorEntity -> Maybe ConnectorType
$sel:connectorProfileName:DescribeConnectorEntity' :: DescribeConnectorEntity -> Maybe Text
$sel:apiVersion:DescribeConnectorEntity' :: DescribeConnectorEntity -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
apiVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
connectorProfileName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConnectorType
connectorType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectorEntityName

instance Prelude.NFData DescribeConnectorEntity where
  rnf :: DescribeConnectorEntity -> ()
rnf DescribeConnectorEntity' {Maybe Text
Maybe ConnectorType
Text
connectorEntityName :: Text
connectorType :: Maybe ConnectorType
connectorProfileName :: Maybe Text
apiVersion :: Maybe Text
$sel:connectorEntityName:DescribeConnectorEntity' :: DescribeConnectorEntity -> Text
$sel:connectorType:DescribeConnectorEntity' :: DescribeConnectorEntity -> Maybe ConnectorType
$sel:connectorProfileName:DescribeConnectorEntity' :: DescribeConnectorEntity -> Maybe Text
$sel:apiVersion:DescribeConnectorEntity' :: DescribeConnectorEntity -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
apiVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectorProfileName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConnectorType
connectorType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectorEntityName

instance Data.ToHeaders DescribeConnectorEntity where
  toHeaders :: DescribeConnectorEntity -> 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.ToJSON DescribeConnectorEntity where
  toJSON :: DescribeConnectorEntity -> Value
toJSON DescribeConnectorEntity' {Maybe Text
Maybe ConnectorType
Text
connectorEntityName :: Text
connectorType :: Maybe ConnectorType
connectorProfileName :: Maybe Text
apiVersion :: Maybe Text
$sel:connectorEntityName:DescribeConnectorEntity' :: DescribeConnectorEntity -> Text
$sel:connectorType:DescribeConnectorEntity' :: DescribeConnectorEntity -> Maybe ConnectorType
$sel:connectorProfileName:DescribeConnectorEntity' :: DescribeConnectorEntity -> Maybe Text
$sel:apiVersion:DescribeConnectorEntity' :: DescribeConnectorEntity -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"apiVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
apiVersion,
            (Key
"connectorProfileName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
connectorProfileName,
            (Key
"connectorType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ConnectorType
connectorType,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"connectorEntityName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
connectorEntityName)
          ]
      )

instance Data.ToPath DescribeConnectorEntity where
  toPath :: DescribeConnectorEntity -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/describe-connector-entity"

instance Data.ToQuery DescribeConnectorEntity where
  toQuery :: DescribeConnectorEntity -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newDescribeConnectorEntityResponse' smart constructor.
data DescribeConnectorEntityResponse = DescribeConnectorEntityResponse'
  { -- | The response's http status code.
    DescribeConnectorEntityResponse -> Int
httpStatus :: Prelude.Int,
    -- | Describes the fields for that connector entity. For example, for an
    -- /account/ entity, the fields would be /account name/, /account ID/, and
    -- so on.
    DescribeConnectorEntityResponse -> [ConnectorEntityField]
connectorEntityFields :: [ConnectorEntityField]
  }
  deriving (DescribeConnectorEntityResponse
-> DescribeConnectorEntityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeConnectorEntityResponse
-> DescribeConnectorEntityResponse -> Bool
$c/= :: DescribeConnectorEntityResponse
-> DescribeConnectorEntityResponse -> Bool
== :: DescribeConnectorEntityResponse
-> DescribeConnectorEntityResponse -> Bool
$c== :: DescribeConnectorEntityResponse
-> DescribeConnectorEntityResponse -> Bool
Prelude.Eq, ReadPrec [DescribeConnectorEntityResponse]
ReadPrec DescribeConnectorEntityResponse
Int -> ReadS DescribeConnectorEntityResponse
ReadS [DescribeConnectorEntityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeConnectorEntityResponse]
$creadListPrec :: ReadPrec [DescribeConnectorEntityResponse]
readPrec :: ReadPrec DescribeConnectorEntityResponse
$creadPrec :: ReadPrec DescribeConnectorEntityResponse
readList :: ReadS [DescribeConnectorEntityResponse]
$creadList :: ReadS [DescribeConnectorEntityResponse]
readsPrec :: Int -> ReadS DescribeConnectorEntityResponse
$creadsPrec :: Int -> ReadS DescribeConnectorEntityResponse
Prelude.Read, Int -> DescribeConnectorEntityResponse -> ShowS
[DescribeConnectorEntityResponse] -> ShowS
DescribeConnectorEntityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeConnectorEntityResponse] -> ShowS
$cshowList :: [DescribeConnectorEntityResponse] -> ShowS
show :: DescribeConnectorEntityResponse -> String
$cshow :: DescribeConnectorEntityResponse -> String
showsPrec :: Int -> DescribeConnectorEntityResponse -> ShowS
$cshowsPrec :: Int -> DescribeConnectorEntityResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeConnectorEntityResponse x
-> DescribeConnectorEntityResponse
forall x.
DescribeConnectorEntityResponse
-> Rep DescribeConnectorEntityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeConnectorEntityResponse x
-> DescribeConnectorEntityResponse
$cfrom :: forall x.
DescribeConnectorEntityResponse
-> Rep DescribeConnectorEntityResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeConnectorEntityResponse' 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:
--
-- 'httpStatus', 'describeConnectorEntityResponse_httpStatus' - The response's http status code.
--
-- 'connectorEntityFields', 'describeConnectorEntityResponse_connectorEntityFields' - Describes the fields for that connector entity. For example, for an
-- /account/ entity, the fields would be /account name/, /account ID/, and
-- so on.
newDescribeConnectorEntityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeConnectorEntityResponse
newDescribeConnectorEntityResponse :: Int -> DescribeConnectorEntityResponse
newDescribeConnectorEntityResponse Int
pHttpStatus_ =
  DescribeConnectorEntityResponse'
    { $sel:httpStatus:DescribeConnectorEntityResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:connectorEntityFields:DescribeConnectorEntityResponse' :: [ConnectorEntityField]
connectorEntityFields = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | Describes the fields for that connector entity. For example, for an
-- /account/ entity, the fields would be /account name/, /account ID/, and
-- so on.
describeConnectorEntityResponse_connectorEntityFields :: Lens.Lens' DescribeConnectorEntityResponse [ConnectorEntityField]
describeConnectorEntityResponse_connectorEntityFields :: Lens' DescribeConnectorEntityResponse [ConnectorEntityField]
describeConnectorEntityResponse_connectorEntityFields = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConnectorEntityResponse' {[ConnectorEntityField]
connectorEntityFields :: [ConnectorEntityField]
$sel:connectorEntityFields:DescribeConnectorEntityResponse' :: DescribeConnectorEntityResponse -> [ConnectorEntityField]
connectorEntityFields} -> [ConnectorEntityField]
connectorEntityFields) (\s :: DescribeConnectorEntityResponse
s@DescribeConnectorEntityResponse' {} [ConnectorEntityField]
a -> DescribeConnectorEntityResponse
s {$sel:connectorEntityFields:DescribeConnectorEntityResponse' :: [ConnectorEntityField]
connectorEntityFields = [ConnectorEntityField]
a} :: DescribeConnectorEntityResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Prelude.NFData
    DescribeConnectorEntityResponse
  where
  rnf :: DescribeConnectorEntityResponse -> ()
rnf DescribeConnectorEntityResponse' {Int
[ConnectorEntityField]
connectorEntityFields :: [ConnectorEntityField]
httpStatus :: Int
$sel:connectorEntityFields:DescribeConnectorEntityResponse' :: DescribeConnectorEntityResponse -> [ConnectorEntityField]
$sel:httpStatus:DescribeConnectorEntityResponse' :: DescribeConnectorEntityResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ConnectorEntityField]
connectorEntityFields