{-# 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.Kafka.DescribeConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a description of this MSK configuration.
module Amazonka.Kafka.DescribeConfiguration
  ( -- * Creating a Request
    DescribeConfiguration (..),
    newDescribeConfiguration,

    -- * Request Lenses
    describeConfiguration_arn,

    -- * Destructuring the Response
    DescribeConfigurationResponse (..),
    newDescribeConfigurationResponse,

    -- * Response Lenses
    describeConfigurationResponse_arn,
    describeConfigurationResponse_creationTime,
    describeConfigurationResponse_description,
    describeConfigurationResponse_kafkaVersions,
    describeConfigurationResponse_latestRevision,
    describeConfigurationResponse_name,
    describeConfigurationResponse_state,
    describeConfigurationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeConfiguration' smart constructor.
data DescribeConfiguration = DescribeConfiguration'
  { -- | The Amazon Resource Name (ARN) that uniquely identifies an MSK
    -- configuration and all of its revisions.
    DescribeConfiguration -> Text
arn :: Prelude.Text
  }
  deriving (DescribeConfiguration -> DescribeConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeConfiguration -> DescribeConfiguration -> Bool
$c/= :: DescribeConfiguration -> DescribeConfiguration -> Bool
== :: DescribeConfiguration -> DescribeConfiguration -> Bool
$c== :: DescribeConfiguration -> DescribeConfiguration -> Bool
Prelude.Eq, ReadPrec [DescribeConfiguration]
ReadPrec DescribeConfiguration
Int -> ReadS DescribeConfiguration
ReadS [DescribeConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeConfiguration]
$creadListPrec :: ReadPrec [DescribeConfiguration]
readPrec :: ReadPrec DescribeConfiguration
$creadPrec :: ReadPrec DescribeConfiguration
readList :: ReadS [DescribeConfiguration]
$creadList :: ReadS [DescribeConfiguration]
readsPrec :: Int -> ReadS DescribeConfiguration
$creadsPrec :: Int -> ReadS DescribeConfiguration
Prelude.Read, Int -> DescribeConfiguration -> ShowS
[DescribeConfiguration] -> ShowS
DescribeConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeConfiguration] -> ShowS
$cshowList :: [DescribeConfiguration] -> ShowS
show :: DescribeConfiguration -> String
$cshow :: DescribeConfiguration -> String
showsPrec :: Int -> DescribeConfiguration -> ShowS
$cshowsPrec :: Int -> DescribeConfiguration -> ShowS
Prelude.Show, forall x. Rep DescribeConfiguration x -> DescribeConfiguration
forall x. DescribeConfiguration -> Rep DescribeConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeConfiguration x -> DescribeConfiguration
$cfrom :: forall x. DescribeConfiguration -> Rep DescribeConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'DescribeConfiguration' 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:
--
-- 'arn', 'describeConfiguration_arn' - The Amazon Resource Name (ARN) that uniquely identifies an MSK
-- configuration and all of its revisions.
newDescribeConfiguration ::
  -- | 'arn'
  Prelude.Text ->
  DescribeConfiguration
newDescribeConfiguration :: Text -> DescribeConfiguration
newDescribeConfiguration Text
pArn_ =
  DescribeConfiguration' {$sel:arn:DescribeConfiguration' :: Text
arn = Text
pArn_}

-- | The Amazon Resource Name (ARN) that uniquely identifies an MSK
-- configuration and all of its revisions.
describeConfiguration_arn :: Lens.Lens' DescribeConfiguration Prelude.Text
describeConfiguration_arn :: Lens' DescribeConfiguration Text
describeConfiguration_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConfiguration' {Text
arn :: Text
$sel:arn:DescribeConfiguration' :: DescribeConfiguration -> Text
arn} -> Text
arn) (\s :: DescribeConfiguration
s@DescribeConfiguration' {} Text
a -> DescribeConfiguration
s {$sel:arn:DescribeConfiguration' :: Text
arn = Text
a} :: DescribeConfiguration)

instance Core.AWSRequest DescribeConfiguration where
  type
    AWSResponse DescribeConfiguration =
      DescribeConfigurationResponse
  request :: (Service -> Service)
-> DescribeConfiguration -> Request DescribeConfiguration
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 DescribeConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeConfiguration)))
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 Text
-> Maybe ISO8601
-> Maybe Text
-> Maybe [Text]
-> Maybe ConfigurationRevision
-> Maybe Text
-> Maybe ConfigurationState
-> Int
-> DescribeConfigurationResponse
DescribeConfigurationResponse'
            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
"arn")
            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
"creationTime")
            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
"description")
            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
"kafkaVersions" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"latestRevision")
            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
"name")
            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
"state")
            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 DescribeConfiguration where
  hashWithSalt :: Int -> DescribeConfiguration -> Int
hashWithSalt Int
_salt DescribeConfiguration' {Text
arn :: Text
$sel:arn:DescribeConfiguration' :: DescribeConfiguration -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

instance Prelude.NFData DescribeConfiguration where
  rnf :: DescribeConfiguration -> ()
rnf DescribeConfiguration' {Text
arn :: Text
$sel:arn:DescribeConfiguration' :: DescribeConfiguration -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
arn

instance Data.ToHeaders DescribeConfiguration where
  toHeaders :: DescribeConfiguration -> 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 DescribeConfiguration where
  toPath :: DescribeConfiguration -> ByteString
toPath DescribeConfiguration' {Text
arn :: Text
$sel:arn:DescribeConfiguration' :: DescribeConfiguration -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/v1/configurations/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
arn]

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

-- | /See:/ 'newDescribeConfigurationResponse' smart constructor.
data DescribeConfigurationResponse = DescribeConfigurationResponse'
  { -- | The Amazon Resource Name (ARN) of the configuration.
    DescribeConfigurationResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The time when the configuration was created.
    DescribeConfigurationResponse -> Maybe ISO8601
creationTime :: Prelude.Maybe Data.ISO8601,
    -- | The description of the configuration.
    DescribeConfigurationResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The versions of Apache Kafka with which you can use this MSK
    -- configuration.
    DescribeConfigurationResponse -> Maybe [Text]
kafkaVersions :: Prelude.Maybe [Prelude.Text],
    -- | Latest revision of the configuration.
    DescribeConfigurationResponse -> Maybe ConfigurationRevision
latestRevision :: Prelude.Maybe ConfigurationRevision,
    -- | The name of the configuration.
    DescribeConfigurationResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The state of the configuration. The possible states are ACTIVE,
    -- DELETING, and DELETE_FAILED.
    DescribeConfigurationResponse -> Maybe ConfigurationState
state :: Prelude.Maybe ConfigurationState,
    -- | The response's http status code.
    DescribeConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeConfigurationResponse
-> DescribeConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeConfigurationResponse
-> DescribeConfigurationResponse -> Bool
$c/= :: DescribeConfigurationResponse
-> DescribeConfigurationResponse -> Bool
== :: DescribeConfigurationResponse
-> DescribeConfigurationResponse -> Bool
$c== :: DescribeConfigurationResponse
-> DescribeConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [DescribeConfigurationResponse]
ReadPrec DescribeConfigurationResponse
Int -> ReadS DescribeConfigurationResponse
ReadS [DescribeConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeConfigurationResponse]
$creadListPrec :: ReadPrec [DescribeConfigurationResponse]
readPrec :: ReadPrec DescribeConfigurationResponse
$creadPrec :: ReadPrec DescribeConfigurationResponse
readList :: ReadS [DescribeConfigurationResponse]
$creadList :: ReadS [DescribeConfigurationResponse]
readsPrec :: Int -> ReadS DescribeConfigurationResponse
$creadsPrec :: Int -> ReadS DescribeConfigurationResponse
Prelude.Read, Int -> DescribeConfigurationResponse -> ShowS
[DescribeConfigurationResponse] -> ShowS
DescribeConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeConfigurationResponse] -> ShowS
$cshowList :: [DescribeConfigurationResponse] -> ShowS
show :: DescribeConfigurationResponse -> String
$cshow :: DescribeConfigurationResponse -> String
showsPrec :: Int -> DescribeConfigurationResponse -> ShowS
$cshowsPrec :: Int -> DescribeConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeConfigurationResponse x
-> DescribeConfigurationResponse
forall x.
DescribeConfigurationResponse
-> Rep DescribeConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeConfigurationResponse x
-> DescribeConfigurationResponse
$cfrom :: forall x.
DescribeConfigurationResponse
-> Rep DescribeConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeConfigurationResponse' 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:
--
-- 'arn', 'describeConfigurationResponse_arn' - The Amazon Resource Name (ARN) of the configuration.
--
-- 'creationTime', 'describeConfigurationResponse_creationTime' - The time when the configuration was created.
--
-- 'description', 'describeConfigurationResponse_description' - The description of the configuration.
--
-- 'kafkaVersions', 'describeConfigurationResponse_kafkaVersions' - The versions of Apache Kafka with which you can use this MSK
-- configuration.
--
-- 'latestRevision', 'describeConfigurationResponse_latestRevision' - Latest revision of the configuration.
--
-- 'name', 'describeConfigurationResponse_name' - The name of the configuration.
--
-- 'state', 'describeConfigurationResponse_state' - The state of the configuration. The possible states are ACTIVE,
-- DELETING, and DELETE_FAILED.
--
-- 'httpStatus', 'describeConfigurationResponse_httpStatus' - The response's http status code.
newDescribeConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeConfigurationResponse
newDescribeConfigurationResponse :: Int -> DescribeConfigurationResponse
newDescribeConfigurationResponse Int
pHttpStatus_ =
  DescribeConfigurationResponse'
    { $sel:arn:DescribeConfigurationResponse' :: Maybe Text
arn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:DescribeConfigurationResponse' :: Maybe ISO8601
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:description:DescribeConfigurationResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:kafkaVersions:DescribeConfigurationResponse' :: Maybe [Text]
kafkaVersions = forall a. Maybe a
Prelude.Nothing,
      $sel:latestRevision:DescribeConfigurationResponse' :: Maybe ConfigurationRevision
latestRevision = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DescribeConfigurationResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:state:DescribeConfigurationResponse' :: Maybe ConfigurationState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the configuration.
describeConfigurationResponse_arn :: Lens.Lens' DescribeConfigurationResponse (Prelude.Maybe Prelude.Text)
describeConfigurationResponse_arn :: Lens' DescribeConfigurationResponse (Maybe Text)
describeConfigurationResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConfigurationResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: DescribeConfigurationResponse
s@DescribeConfigurationResponse' {} Maybe Text
a -> DescribeConfigurationResponse
s {$sel:arn:DescribeConfigurationResponse' :: Maybe Text
arn = Maybe Text
a} :: DescribeConfigurationResponse)

-- | The time when the configuration was created.
describeConfigurationResponse_creationTime :: Lens.Lens' DescribeConfigurationResponse (Prelude.Maybe Prelude.UTCTime)
describeConfigurationResponse_creationTime :: Lens' DescribeConfigurationResponse (Maybe UTCTime)
describeConfigurationResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConfigurationResponse' {Maybe ISO8601
creationTime :: Maybe ISO8601
$sel:creationTime:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe ISO8601
creationTime} -> Maybe ISO8601
creationTime) (\s :: DescribeConfigurationResponse
s@DescribeConfigurationResponse' {} Maybe ISO8601
a -> DescribeConfigurationResponse
s {$sel:creationTime:DescribeConfigurationResponse' :: Maybe ISO8601
creationTime = Maybe ISO8601
a} :: DescribeConfigurationResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The description of the configuration.
describeConfigurationResponse_description :: Lens.Lens' DescribeConfigurationResponse (Prelude.Maybe Prelude.Text)
describeConfigurationResponse_description :: Lens' DescribeConfigurationResponse (Maybe Text)
describeConfigurationResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConfigurationResponse' {Maybe Text
description :: Maybe Text
$sel:description:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: DescribeConfigurationResponse
s@DescribeConfigurationResponse' {} Maybe Text
a -> DescribeConfigurationResponse
s {$sel:description:DescribeConfigurationResponse' :: Maybe Text
description = Maybe Text
a} :: DescribeConfigurationResponse)

-- | The versions of Apache Kafka with which you can use this MSK
-- configuration.
describeConfigurationResponse_kafkaVersions :: Lens.Lens' DescribeConfigurationResponse (Prelude.Maybe [Prelude.Text])
describeConfigurationResponse_kafkaVersions :: Lens' DescribeConfigurationResponse (Maybe [Text])
describeConfigurationResponse_kafkaVersions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConfigurationResponse' {Maybe [Text]
kafkaVersions :: Maybe [Text]
$sel:kafkaVersions:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe [Text]
kafkaVersions} -> Maybe [Text]
kafkaVersions) (\s :: DescribeConfigurationResponse
s@DescribeConfigurationResponse' {} Maybe [Text]
a -> DescribeConfigurationResponse
s {$sel:kafkaVersions:DescribeConfigurationResponse' :: Maybe [Text]
kafkaVersions = Maybe [Text]
a} :: DescribeConfigurationResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Latest revision of the configuration.
describeConfigurationResponse_latestRevision :: Lens.Lens' DescribeConfigurationResponse (Prelude.Maybe ConfigurationRevision)
describeConfigurationResponse_latestRevision :: Lens' DescribeConfigurationResponse (Maybe ConfigurationRevision)
describeConfigurationResponse_latestRevision = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConfigurationResponse' {Maybe ConfigurationRevision
latestRevision :: Maybe ConfigurationRevision
$sel:latestRevision:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe ConfigurationRevision
latestRevision} -> Maybe ConfigurationRevision
latestRevision) (\s :: DescribeConfigurationResponse
s@DescribeConfigurationResponse' {} Maybe ConfigurationRevision
a -> DescribeConfigurationResponse
s {$sel:latestRevision:DescribeConfigurationResponse' :: Maybe ConfigurationRevision
latestRevision = Maybe ConfigurationRevision
a} :: DescribeConfigurationResponse)

-- | The name of the configuration.
describeConfigurationResponse_name :: Lens.Lens' DescribeConfigurationResponse (Prelude.Maybe Prelude.Text)
describeConfigurationResponse_name :: Lens' DescribeConfigurationResponse (Maybe Text)
describeConfigurationResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConfigurationResponse' {Maybe Text
name :: Maybe Text
$sel:name:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: DescribeConfigurationResponse
s@DescribeConfigurationResponse' {} Maybe Text
a -> DescribeConfigurationResponse
s {$sel:name:DescribeConfigurationResponse' :: Maybe Text
name = Maybe Text
a} :: DescribeConfigurationResponse)

-- | The state of the configuration. The possible states are ACTIVE,
-- DELETING, and DELETE_FAILED.
describeConfigurationResponse_state :: Lens.Lens' DescribeConfigurationResponse (Prelude.Maybe ConfigurationState)
describeConfigurationResponse_state :: Lens' DescribeConfigurationResponse (Maybe ConfigurationState)
describeConfigurationResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConfigurationResponse' {Maybe ConfigurationState
state :: Maybe ConfigurationState
$sel:state:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe ConfigurationState
state} -> Maybe ConfigurationState
state) (\s :: DescribeConfigurationResponse
s@DescribeConfigurationResponse' {} Maybe ConfigurationState
a -> DescribeConfigurationResponse
s {$sel:state:DescribeConfigurationResponse' :: Maybe ConfigurationState
state = Maybe ConfigurationState
a} :: DescribeConfigurationResponse)

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

instance Prelude.NFData DescribeConfigurationResponse where
  rnf :: DescribeConfigurationResponse -> ()
rnf DescribeConfigurationResponse' {Int
Maybe [Text]
Maybe Text
Maybe ISO8601
Maybe ConfigurationRevision
Maybe ConfigurationState
httpStatus :: Int
state :: Maybe ConfigurationState
name :: Maybe Text
latestRevision :: Maybe ConfigurationRevision
kafkaVersions :: Maybe [Text]
description :: Maybe Text
creationTime :: Maybe ISO8601
arn :: Maybe Text
$sel:httpStatus:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Int
$sel:state:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe ConfigurationState
$sel:name:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe Text
$sel:latestRevision:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe ConfigurationRevision
$sel:kafkaVersions:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe [Text]
$sel:description:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe Text
$sel:creationTime:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe ISO8601
$sel:arn:DescribeConfigurationResponse' :: DescribeConfigurationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
kafkaVersions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConfigurationRevision
latestRevision
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConfigurationState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus