{-# 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.IoT.DescribeDomainConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets summary information about a domain configuration.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions DescribeDomainConfiguration>
-- action.
module Amazonka.IoT.DescribeDomainConfiguration
  ( -- * Creating a Request
    DescribeDomainConfiguration (..),
    newDescribeDomainConfiguration,

    -- * Request Lenses
    describeDomainConfiguration_domainConfigurationName,

    -- * Destructuring the Response
    DescribeDomainConfigurationResponse (..),
    newDescribeDomainConfigurationResponse,

    -- * Response Lenses
    describeDomainConfigurationResponse_authorizerConfig,
    describeDomainConfigurationResponse_domainConfigurationArn,
    describeDomainConfigurationResponse_domainConfigurationName,
    describeDomainConfigurationResponse_domainConfigurationStatus,
    describeDomainConfigurationResponse_domainName,
    describeDomainConfigurationResponse_domainType,
    describeDomainConfigurationResponse_lastStatusChangeDate,
    describeDomainConfigurationResponse_serverCertificates,
    describeDomainConfigurationResponse_serviceType,
    describeDomainConfigurationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeDomainConfiguration' smart constructor.
data DescribeDomainConfiguration = DescribeDomainConfiguration'
  { -- | The name of the domain configuration.
    DescribeDomainConfiguration -> Text
domainConfigurationName :: Prelude.Text
  }
  deriving (DescribeDomainConfiguration -> DescribeDomainConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDomainConfiguration -> DescribeDomainConfiguration -> Bool
$c/= :: DescribeDomainConfiguration -> DescribeDomainConfiguration -> Bool
== :: DescribeDomainConfiguration -> DescribeDomainConfiguration -> Bool
$c== :: DescribeDomainConfiguration -> DescribeDomainConfiguration -> Bool
Prelude.Eq, ReadPrec [DescribeDomainConfiguration]
ReadPrec DescribeDomainConfiguration
Int -> ReadS DescribeDomainConfiguration
ReadS [DescribeDomainConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDomainConfiguration]
$creadListPrec :: ReadPrec [DescribeDomainConfiguration]
readPrec :: ReadPrec DescribeDomainConfiguration
$creadPrec :: ReadPrec DescribeDomainConfiguration
readList :: ReadS [DescribeDomainConfiguration]
$creadList :: ReadS [DescribeDomainConfiguration]
readsPrec :: Int -> ReadS DescribeDomainConfiguration
$creadsPrec :: Int -> ReadS DescribeDomainConfiguration
Prelude.Read, Int -> DescribeDomainConfiguration -> ShowS
[DescribeDomainConfiguration] -> ShowS
DescribeDomainConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDomainConfiguration] -> ShowS
$cshowList :: [DescribeDomainConfiguration] -> ShowS
show :: DescribeDomainConfiguration -> String
$cshow :: DescribeDomainConfiguration -> String
showsPrec :: Int -> DescribeDomainConfiguration -> ShowS
$cshowsPrec :: Int -> DescribeDomainConfiguration -> ShowS
Prelude.Show, forall x.
Rep DescribeDomainConfiguration x -> DescribeDomainConfiguration
forall x.
DescribeDomainConfiguration -> Rep DescribeDomainConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDomainConfiguration x -> DescribeDomainConfiguration
$cfrom :: forall x.
DescribeDomainConfiguration -> Rep DescribeDomainConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDomainConfiguration' 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:
--
-- 'domainConfigurationName', 'describeDomainConfiguration_domainConfigurationName' - The name of the domain configuration.
newDescribeDomainConfiguration ::
  -- | 'domainConfigurationName'
  Prelude.Text ->
  DescribeDomainConfiguration
newDescribeDomainConfiguration :: Text -> DescribeDomainConfiguration
newDescribeDomainConfiguration
  Text
pDomainConfigurationName_ =
    DescribeDomainConfiguration'
      { $sel:domainConfigurationName:DescribeDomainConfiguration' :: Text
domainConfigurationName =
          Text
pDomainConfigurationName_
      }

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

instance Core.AWSRequest DescribeDomainConfiguration where
  type
    AWSResponse DescribeDomainConfiguration =
      DescribeDomainConfigurationResponse
  request :: (Service -> Service)
-> DescribeDomainConfiguration
-> Request DescribeDomainConfiguration
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 DescribeDomainConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeDomainConfiguration)))
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 AuthorizerConfig
-> Maybe Text
-> Maybe Text
-> Maybe DomainConfigurationStatus
-> Maybe Text
-> Maybe DomainType
-> Maybe POSIX
-> Maybe [ServerCertificateSummary]
-> Maybe ServiceType
-> Int
-> DescribeDomainConfigurationResponse
DescribeDomainConfigurationResponse'
            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
"authorizerConfig")
            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
"domainConfigurationArn")
            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
"domainConfigurationName")
            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
"domainConfigurationStatus")
            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
"domainName")
            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
"domainType")
            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
"lastStatusChangeDate")
            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
"serverCertificates"
                            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
"serviceType")
            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 DescribeDomainConfiguration where
  hashWithSalt :: Int -> DescribeDomainConfiguration -> Int
hashWithSalt Int
_salt DescribeDomainConfiguration' {Text
domainConfigurationName :: Text
$sel:domainConfigurationName:DescribeDomainConfiguration' :: DescribeDomainConfiguration -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainConfigurationName

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

instance Data.ToHeaders DescribeDomainConfiguration where
  toHeaders :: DescribeDomainConfiguration -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DescribeDomainConfiguration where
  toPath :: DescribeDomainConfiguration -> ByteString
toPath DescribeDomainConfiguration' {Text
domainConfigurationName :: Text
$sel:domainConfigurationName:DescribeDomainConfiguration' :: DescribeDomainConfiguration -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domainConfigurations/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainConfigurationName
      ]

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

-- | /See:/ 'newDescribeDomainConfigurationResponse' smart constructor.
data DescribeDomainConfigurationResponse = DescribeDomainConfigurationResponse'
  { -- | An object that specifies the authorization service for a domain.
    DescribeDomainConfigurationResponse -> Maybe AuthorizerConfig
authorizerConfig :: Prelude.Maybe AuthorizerConfig,
    -- | The ARN of the domain configuration.
    DescribeDomainConfigurationResponse -> Maybe Text
domainConfigurationArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the domain configuration.
    DescribeDomainConfigurationResponse -> Maybe Text
domainConfigurationName :: Prelude.Maybe Prelude.Text,
    -- | A Boolean value that specifies the current state of the domain
    -- configuration.
    DescribeDomainConfigurationResponse
-> Maybe DomainConfigurationStatus
domainConfigurationStatus :: Prelude.Maybe DomainConfigurationStatus,
    -- | The name of the domain.
    DescribeDomainConfigurationResponse -> Maybe Text
domainName :: Prelude.Maybe Prelude.Text,
    -- | The type of the domain.
    DescribeDomainConfigurationResponse -> Maybe DomainType
domainType :: Prelude.Maybe DomainType,
    -- | The date and time the domain configuration\'s status was last changed.
    DescribeDomainConfigurationResponse -> Maybe POSIX
lastStatusChangeDate :: Prelude.Maybe Data.POSIX,
    -- | A list containing summary information about the server certificate
    -- included in the domain configuration.
    DescribeDomainConfigurationResponse
-> Maybe [ServerCertificateSummary]
serverCertificates :: Prelude.Maybe [ServerCertificateSummary],
    -- | The type of service delivered by the endpoint.
    DescribeDomainConfigurationResponse -> Maybe ServiceType
serviceType :: Prelude.Maybe ServiceType,
    -- | The response's http status code.
    DescribeDomainConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeDomainConfigurationResponse
-> DescribeDomainConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDomainConfigurationResponse
-> DescribeDomainConfigurationResponse -> Bool
$c/= :: DescribeDomainConfigurationResponse
-> DescribeDomainConfigurationResponse -> Bool
== :: DescribeDomainConfigurationResponse
-> DescribeDomainConfigurationResponse -> Bool
$c== :: DescribeDomainConfigurationResponse
-> DescribeDomainConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [DescribeDomainConfigurationResponse]
ReadPrec DescribeDomainConfigurationResponse
Int -> ReadS DescribeDomainConfigurationResponse
ReadS [DescribeDomainConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDomainConfigurationResponse]
$creadListPrec :: ReadPrec [DescribeDomainConfigurationResponse]
readPrec :: ReadPrec DescribeDomainConfigurationResponse
$creadPrec :: ReadPrec DescribeDomainConfigurationResponse
readList :: ReadS [DescribeDomainConfigurationResponse]
$creadList :: ReadS [DescribeDomainConfigurationResponse]
readsPrec :: Int -> ReadS DescribeDomainConfigurationResponse
$creadsPrec :: Int -> ReadS DescribeDomainConfigurationResponse
Prelude.Read, Int -> DescribeDomainConfigurationResponse -> ShowS
[DescribeDomainConfigurationResponse] -> ShowS
DescribeDomainConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDomainConfigurationResponse] -> ShowS
$cshowList :: [DescribeDomainConfigurationResponse] -> ShowS
show :: DescribeDomainConfigurationResponse -> String
$cshow :: DescribeDomainConfigurationResponse -> String
showsPrec :: Int -> DescribeDomainConfigurationResponse -> ShowS
$cshowsPrec :: Int -> DescribeDomainConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeDomainConfigurationResponse x
-> DescribeDomainConfigurationResponse
forall x.
DescribeDomainConfigurationResponse
-> Rep DescribeDomainConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDomainConfigurationResponse x
-> DescribeDomainConfigurationResponse
$cfrom :: forall x.
DescribeDomainConfigurationResponse
-> Rep DescribeDomainConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDomainConfigurationResponse' 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:
--
-- 'authorizerConfig', 'describeDomainConfigurationResponse_authorizerConfig' - An object that specifies the authorization service for a domain.
--
-- 'domainConfigurationArn', 'describeDomainConfigurationResponse_domainConfigurationArn' - The ARN of the domain configuration.
--
-- 'domainConfigurationName', 'describeDomainConfigurationResponse_domainConfigurationName' - The name of the domain configuration.
--
-- 'domainConfigurationStatus', 'describeDomainConfigurationResponse_domainConfigurationStatus' - A Boolean value that specifies the current state of the domain
-- configuration.
--
-- 'domainName', 'describeDomainConfigurationResponse_domainName' - The name of the domain.
--
-- 'domainType', 'describeDomainConfigurationResponse_domainType' - The type of the domain.
--
-- 'lastStatusChangeDate', 'describeDomainConfigurationResponse_lastStatusChangeDate' - The date and time the domain configuration\'s status was last changed.
--
-- 'serverCertificates', 'describeDomainConfigurationResponse_serverCertificates' - A list containing summary information about the server certificate
-- included in the domain configuration.
--
-- 'serviceType', 'describeDomainConfigurationResponse_serviceType' - The type of service delivered by the endpoint.
--
-- 'httpStatus', 'describeDomainConfigurationResponse_httpStatus' - The response's http status code.
newDescribeDomainConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeDomainConfigurationResponse
newDescribeDomainConfigurationResponse :: Int -> DescribeDomainConfigurationResponse
newDescribeDomainConfigurationResponse Int
pHttpStatus_ =
  DescribeDomainConfigurationResponse'
    { $sel:authorizerConfig:DescribeDomainConfigurationResponse' :: Maybe AuthorizerConfig
authorizerConfig =
        forall a. Maybe a
Prelude.Nothing,
      $sel:domainConfigurationArn:DescribeDomainConfigurationResponse' :: Maybe Text
domainConfigurationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:domainConfigurationName:DescribeDomainConfigurationResponse' :: Maybe Text
domainConfigurationName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:domainConfigurationStatus:DescribeDomainConfigurationResponse' :: Maybe DomainConfigurationStatus
domainConfigurationStatus =
        forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:DescribeDomainConfigurationResponse' :: Maybe Text
domainName = forall a. Maybe a
Prelude.Nothing,
      $sel:domainType:DescribeDomainConfigurationResponse' :: Maybe DomainType
domainType = forall a. Maybe a
Prelude.Nothing,
      $sel:lastStatusChangeDate:DescribeDomainConfigurationResponse' :: Maybe POSIX
lastStatusChangeDate = forall a. Maybe a
Prelude.Nothing,
      $sel:serverCertificates:DescribeDomainConfigurationResponse' :: Maybe [ServerCertificateSummary]
serverCertificates = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceType:DescribeDomainConfigurationResponse' :: Maybe ServiceType
serviceType = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeDomainConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that specifies the authorization service for a domain.
describeDomainConfigurationResponse_authorizerConfig :: Lens.Lens' DescribeDomainConfigurationResponse (Prelude.Maybe AuthorizerConfig)
describeDomainConfigurationResponse_authorizerConfig :: Lens' DescribeDomainConfigurationResponse (Maybe AuthorizerConfig)
describeDomainConfigurationResponse_authorizerConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDomainConfigurationResponse' {Maybe AuthorizerConfig
authorizerConfig :: Maybe AuthorizerConfig
$sel:authorizerConfig:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Maybe AuthorizerConfig
authorizerConfig} -> Maybe AuthorizerConfig
authorizerConfig) (\s :: DescribeDomainConfigurationResponse
s@DescribeDomainConfigurationResponse' {} Maybe AuthorizerConfig
a -> DescribeDomainConfigurationResponse
s {$sel:authorizerConfig:DescribeDomainConfigurationResponse' :: Maybe AuthorizerConfig
authorizerConfig = Maybe AuthorizerConfig
a} :: DescribeDomainConfigurationResponse)

-- | The ARN of the domain configuration.
describeDomainConfigurationResponse_domainConfigurationArn :: Lens.Lens' DescribeDomainConfigurationResponse (Prelude.Maybe Prelude.Text)
describeDomainConfigurationResponse_domainConfigurationArn :: Lens' DescribeDomainConfigurationResponse (Maybe Text)
describeDomainConfigurationResponse_domainConfigurationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDomainConfigurationResponse' {Maybe Text
domainConfigurationArn :: Maybe Text
$sel:domainConfigurationArn:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Maybe Text
domainConfigurationArn} -> Maybe Text
domainConfigurationArn) (\s :: DescribeDomainConfigurationResponse
s@DescribeDomainConfigurationResponse' {} Maybe Text
a -> DescribeDomainConfigurationResponse
s {$sel:domainConfigurationArn:DescribeDomainConfigurationResponse' :: Maybe Text
domainConfigurationArn = Maybe Text
a} :: DescribeDomainConfigurationResponse)

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

-- | A Boolean value that specifies the current state of the domain
-- configuration.
describeDomainConfigurationResponse_domainConfigurationStatus :: Lens.Lens' DescribeDomainConfigurationResponse (Prelude.Maybe DomainConfigurationStatus)
describeDomainConfigurationResponse_domainConfigurationStatus :: Lens'
  DescribeDomainConfigurationResponse
  (Maybe DomainConfigurationStatus)
describeDomainConfigurationResponse_domainConfigurationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDomainConfigurationResponse' {Maybe DomainConfigurationStatus
domainConfigurationStatus :: Maybe DomainConfigurationStatus
$sel:domainConfigurationStatus:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse
-> Maybe DomainConfigurationStatus
domainConfigurationStatus} -> Maybe DomainConfigurationStatus
domainConfigurationStatus) (\s :: DescribeDomainConfigurationResponse
s@DescribeDomainConfigurationResponse' {} Maybe DomainConfigurationStatus
a -> DescribeDomainConfigurationResponse
s {$sel:domainConfigurationStatus:DescribeDomainConfigurationResponse' :: Maybe DomainConfigurationStatus
domainConfigurationStatus = Maybe DomainConfigurationStatus
a} :: DescribeDomainConfigurationResponse)

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

-- | The type of the domain.
describeDomainConfigurationResponse_domainType :: Lens.Lens' DescribeDomainConfigurationResponse (Prelude.Maybe DomainType)
describeDomainConfigurationResponse_domainType :: Lens' DescribeDomainConfigurationResponse (Maybe DomainType)
describeDomainConfigurationResponse_domainType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDomainConfigurationResponse' {Maybe DomainType
domainType :: Maybe DomainType
$sel:domainType:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Maybe DomainType
domainType} -> Maybe DomainType
domainType) (\s :: DescribeDomainConfigurationResponse
s@DescribeDomainConfigurationResponse' {} Maybe DomainType
a -> DescribeDomainConfigurationResponse
s {$sel:domainType:DescribeDomainConfigurationResponse' :: Maybe DomainType
domainType = Maybe DomainType
a} :: DescribeDomainConfigurationResponse)

-- | The date and time the domain configuration\'s status was last changed.
describeDomainConfigurationResponse_lastStatusChangeDate :: Lens.Lens' DescribeDomainConfigurationResponse (Prelude.Maybe Prelude.UTCTime)
describeDomainConfigurationResponse_lastStatusChangeDate :: Lens' DescribeDomainConfigurationResponse (Maybe UTCTime)
describeDomainConfigurationResponse_lastStatusChangeDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDomainConfigurationResponse' {Maybe POSIX
lastStatusChangeDate :: Maybe POSIX
$sel:lastStatusChangeDate:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Maybe POSIX
lastStatusChangeDate} -> Maybe POSIX
lastStatusChangeDate) (\s :: DescribeDomainConfigurationResponse
s@DescribeDomainConfigurationResponse' {} Maybe POSIX
a -> DescribeDomainConfigurationResponse
s {$sel:lastStatusChangeDate:DescribeDomainConfigurationResponse' :: Maybe POSIX
lastStatusChangeDate = Maybe POSIX
a} :: DescribeDomainConfigurationResponse) 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

-- | A list containing summary information about the server certificate
-- included in the domain configuration.
describeDomainConfigurationResponse_serverCertificates :: Lens.Lens' DescribeDomainConfigurationResponse (Prelude.Maybe [ServerCertificateSummary])
describeDomainConfigurationResponse_serverCertificates :: Lens'
  DescribeDomainConfigurationResponse
  (Maybe [ServerCertificateSummary])
describeDomainConfigurationResponse_serverCertificates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDomainConfigurationResponse' {Maybe [ServerCertificateSummary]
serverCertificates :: Maybe [ServerCertificateSummary]
$sel:serverCertificates:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse
-> Maybe [ServerCertificateSummary]
serverCertificates} -> Maybe [ServerCertificateSummary]
serverCertificates) (\s :: DescribeDomainConfigurationResponse
s@DescribeDomainConfigurationResponse' {} Maybe [ServerCertificateSummary]
a -> DescribeDomainConfigurationResponse
s {$sel:serverCertificates:DescribeDomainConfigurationResponse' :: Maybe [ServerCertificateSummary]
serverCertificates = Maybe [ServerCertificateSummary]
a} :: DescribeDomainConfigurationResponse) 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

-- | The type of service delivered by the endpoint.
describeDomainConfigurationResponse_serviceType :: Lens.Lens' DescribeDomainConfigurationResponse (Prelude.Maybe ServiceType)
describeDomainConfigurationResponse_serviceType :: Lens' DescribeDomainConfigurationResponse (Maybe ServiceType)
describeDomainConfigurationResponse_serviceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDomainConfigurationResponse' {Maybe ServiceType
serviceType :: Maybe ServiceType
$sel:serviceType:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Maybe ServiceType
serviceType} -> Maybe ServiceType
serviceType) (\s :: DescribeDomainConfigurationResponse
s@DescribeDomainConfigurationResponse' {} Maybe ServiceType
a -> DescribeDomainConfigurationResponse
s {$sel:serviceType:DescribeDomainConfigurationResponse' :: Maybe ServiceType
serviceType = Maybe ServiceType
a} :: DescribeDomainConfigurationResponse)

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

instance
  Prelude.NFData
    DescribeDomainConfigurationResponse
  where
  rnf :: DescribeDomainConfigurationResponse -> ()
rnf DescribeDomainConfigurationResponse' {Int
Maybe [ServerCertificateSummary]
Maybe Text
Maybe POSIX
Maybe AuthorizerConfig
Maybe DomainConfigurationStatus
Maybe DomainType
Maybe ServiceType
httpStatus :: Int
serviceType :: Maybe ServiceType
serverCertificates :: Maybe [ServerCertificateSummary]
lastStatusChangeDate :: Maybe POSIX
domainType :: Maybe DomainType
domainName :: Maybe Text
domainConfigurationStatus :: Maybe DomainConfigurationStatus
domainConfigurationName :: Maybe Text
domainConfigurationArn :: Maybe Text
authorizerConfig :: Maybe AuthorizerConfig
$sel:httpStatus:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Int
$sel:serviceType:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Maybe ServiceType
$sel:serverCertificates:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse
-> Maybe [ServerCertificateSummary]
$sel:lastStatusChangeDate:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Maybe POSIX
$sel:domainType:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Maybe DomainType
$sel:domainName:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Maybe Text
$sel:domainConfigurationStatus:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse
-> Maybe DomainConfigurationStatus
$sel:domainConfigurationName:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Maybe Text
$sel:domainConfigurationArn:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Maybe Text
$sel:authorizerConfig:DescribeDomainConfigurationResponse' :: DescribeDomainConfigurationResponse -> Maybe AuthorizerConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AuthorizerConfig
authorizerConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainConfigurationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainConfigurationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DomainConfigurationStatus
domainConfigurationStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DomainType
domainType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastStatusChangeDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ServerCertificateSummary]
serverCertificates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServiceType
serviceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus