{-# 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.CustomerProfiles.GetDomain
-- 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 information about a specific domain.
module Amazonka.CustomerProfiles.GetDomain
  ( -- * Creating a Request
    GetDomain (..),
    newGetDomain,

    -- * Request Lenses
    getDomain_domainName,

    -- * Destructuring the Response
    GetDomainResponse (..),
    newGetDomainResponse,

    -- * Response Lenses
    getDomainResponse_deadLetterQueueUrl,
    getDomainResponse_defaultEncryptionKey,
    getDomainResponse_defaultExpirationDays,
    getDomainResponse_matching,
    getDomainResponse_stats,
    getDomainResponse_tags,
    getDomainResponse_httpStatus,
    getDomainResponse_domainName,
    getDomainResponse_createdAt,
    getDomainResponse_lastUpdatedAt,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.CustomerProfiles.Types
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:/ 'newGetDomain' smart constructor.
data GetDomain = GetDomain'
  { -- | The unique name of the domain.
    GetDomain -> Text
domainName :: Prelude.Text
  }
  deriving (GetDomain -> GetDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDomain -> GetDomain -> Bool
$c/= :: GetDomain -> GetDomain -> Bool
== :: GetDomain -> GetDomain -> Bool
$c== :: GetDomain -> GetDomain -> Bool
Prelude.Eq, ReadPrec [GetDomain]
ReadPrec GetDomain
Int -> ReadS GetDomain
ReadS [GetDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDomain]
$creadListPrec :: ReadPrec [GetDomain]
readPrec :: ReadPrec GetDomain
$creadPrec :: ReadPrec GetDomain
readList :: ReadS [GetDomain]
$creadList :: ReadS [GetDomain]
readsPrec :: Int -> ReadS GetDomain
$creadsPrec :: Int -> ReadS GetDomain
Prelude.Read, Int -> GetDomain -> ShowS
[GetDomain] -> ShowS
GetDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDomain] -> ShowS
$cshowList :: [GetDomain] -> ShowS
show :: GetDomain -> String
$cshow :: GetDomain -> String
showsPrec :: Int -> GetDomain -> ShowS
$cshowsPrec :: Int -> GetDomain -> ShowS
Prelude.Show, forall x. Rep GetDomain x -> GetDomain
forall x. GetDomain -> Rep GetDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDomain x -> GetDomain
$cfrom :: forall x. GetDomain -> Rep GetDomain x
Prelude.Generic)

-- |
-- Create a value of 'GetDomain' 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:
--
-- 'domainName', 'getDomain_domainName' - The unique name of the domain.
newGetDomain ::
  -- | 'domainName'
  Prelude.Text ->
  GetDomain
newGetDomain :: Text -> GetDomain
newGetDomain Text
pDomainName_ =
  GetDomain' {$sel:domainName:GetDomain' :: Text
domainName = Text
pDomainName_}

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

instance Core.AWSRequest GetDomain where
  type AWSResponse GetDomain = GetDomainResponse
  request :: (Service -> Service) -> GetDomain -> Request GetDomain
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 GetDomain
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDomain)))
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 Text
-> Maybe Natural
-> Maybe MatchingResponse
-> Maybe DomainStats
-> Maybe (HashMap Text Text)
-> Int
-> Text
-> POSIX
-> POSIX
-> GetDomainResponse
GetDomainResponse'
            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
"DeadLetterQueueUrl")
            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
"DefaultEncryptionKey")
            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
"DefaultExpirationDays")
            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
"Matching")
            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
"Stats")
            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
"Tags" 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.<*> (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 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 a
Data..:> Key
"CreatedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"LastUpdatedAt")
      )

instance Prelude.Hashable GetDomain where
  hashWithSalt :: Int -> GetDomain -> Int
hashWithSalt Int
_salt GetDomain' {Text
domainName :: Text
$sel:domainName:GetDomain' :: GetDomain -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

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

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

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

-- | /See:/ 'newGetDomainResponse' smart constructor.
data GetDomainResponse = GetDomainResponse'
  { -- | The URL of the SQS dead letter queue, which is used for reporting errors
    -- associated with ingesting data from third party applications.
    GetDomainResponse -> Maybe Text
deadLetterQueueUrl :: Prelude.Maybe Prelude.Text,
    -- | The default encryption key, which is an AWS managed key, is used when no
    -- specific type of encryption key is specified. It is used to encrypt all
    -- data before it is placed in permanent or semi-permanent storage.
    GetDomainResponse -> Maybe Text
defaultEncryptionKey :: Prelude.Maybe Prelude.Text,
    -- | The default number of days until the data within the domain expires.
    GetDomainResponse -> Maybe Natural
defaultExpirationDays :: Prelude.Maybe Prelude.Natural,
    -- | The process of matching duplicate profiles. If @Matching@ = @true@,
    -- Amazon Connect Customer Profiles starts a weekly batch process called
    -- Identity Resolution Job. If you do not specify a date and time for
    -- Identity Resolution Job to run, by default it runs every Saturday at
    -- 12AM UTC to detect duplicate profiles in your domains.
    --
    -- After the Identity Resolution Job completes, use the
    -- <https://docs.aws.amazon.com/customerprofiles/latest/APIReference/API_GetMatches.html GetMatches>
    -- API to return and review the results. Or, if you have configured
    -- @ExportingConfig@ in the @MatchingRequest@, you can download the results
    -- from S3.
    GetDomainResponse -> Maybe MatchingResponse
matching :: Prelude.Maybe MatchingResponse,
    -- | Usage-specific statistics about the domain.
    GetDomainResponse -> Maybe DomainStats
stats :: Prelude.Maybe DomainStats,
    -- | The tags used to organize, track, or control access for this resource.
    GetDomainResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetDomainResponse -> Int
httpStatus :: Prelude.Int,
    -- | The unique name of the domain.
    GetDomainResponse -> Text
domainName :: Prelude.Text,
    -- | The timestamp of when the domain was created.
    GetDomainResponse -> POSIX
createdAt :: Data.POSIX,
    -- | The timestamp of when the domain was most recently edited.
    GetDomainResponse -> POSIX
lastUpdatedAt :: Data.POSIX
  }
  deriving (GetDomainResponse -> GetDomainResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDomainResponse -> GetDomainResponse -> Bool
$c/= :: GetDomainResponse -> GetDomainResponse -> Bool
== :: GetDomainResponse -> GetDomainResponse -> Bool
$c== :: GetDomainResponse -> GetDomainResponse -> Bool
Prelude.Eq, ReadPrec [GetDomainResponse]
ReadPrec GetDomainResponse
Int -> ReadS GetDomainResponse
ReadS [GetDomainResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDomainResponse]
$creadListPrec :: ReadPrec [GetDomainResponse]
readPrec :: ReadPrec GetDomainResponse
$creadPrec :: ReadPrec GetDomainResponse
readList :: ReadS [GetDomainResponse]
$creadList :: ReadS [GetDomainResponse]
readsPrec :: Int -> ReadS GetDomainResponse
$creadsPrec :: Int -> ReadS GetDomainResponse
Prelude.Read, Int -> GetDomainResponse -> ShowS
[GetDomainResponse] -> ShowS
GetDomainResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDomainResponse] -> ShowS
$cshowList :: [GetDomainResponse] -> ShowS
show :: GetDomainResponse -> String
$cshow :: GetDomainResponse -> String
showsPrec :: Int -> GetDomainResponse -> ShowS
$cshowsPrec :: Int -> GetDomainResponse -> ShowS
Prelude.Show, forall x. Rep GetDomainResponse x -> GetDomainResponse
forall x. GetDomainResponse -> Rep GetDomainResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDomainResponse x -> GetDomainResponse
$cfrom :: forall x. GetDomainResponse -> Rep GetDomainResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDomainResponse' 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:
--
-- 'deadLetterQueueUrl', 'getDomainResponse_deadLetterQueueUrl' - The URL of the SQS dead letter queue, which is used for reporting errors
-- associated with ingesting data from third party applications.
--
-- 'defaultEncryptionKey', 'getDomainResponse_defaultEncryptionKey' - The default encryption key, which is an AWS managed key, is used when no
-- specific type of encryption key is specified. It is used to encrypt all
-- data before it is placed in permanent or semi-permanent storage.
--
-- 'defaultExpirationDays', 'getDomainResponse_defaultExpirationDays' - The default number of days until the data within the domain expires.
--
-- 'matching', 'getDomainResponse_matching' - The process of matching duplicate profiles. If @Matching@ = @true@,
-- Amazon Connect Customer Profiles starts a weekly batch process called
-- Identity Resolution Job. If you do not specify a date and time for
-- Identity Resolution Job to run, by default it runs every Saturday at
-- 12AM UTC to detect duplicate profiles in your domains.
--
-- After the Identity Resolution Job completes, use the
-- <https://docs.aws.amazon.com/customerprofiles/latest/APIReference/API_GetMatches.html GetMatches>
-- API to return and review the results. Or, if you have configured
-- @ExportingConfig@ in the @MatchingRequest@, you can download the results
-- from S3.
--
-- 'stats', 'getDomainResponse_stats' - Usage-specific statistics about the domain.
--
-- 'tags', 'getDomainResponse_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'httpStatus', 'getDomainResponse_httpStatus' - The response's http status code.
--
-- 'domainName', 'getDomainResponse_domainName' - The unique name of the domain.
--
-- 'createdAt', 'getDomainResponse_createdAt' - The timestamp of when the domain was created.
--
-- 'lastUpdatedAt', 'getDomainResponse_lastUpdatedAt' - The timestamp of when the domain was most recently edited.
newGetDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'domainName'
  Prelude.Text ->
  -- | 'createdAt'
  Prelude.UTCTime ->
  -- | 'lastUpdatedAt'
  Prelude.UTCTime ->
  GetDomainResponse
newGetDomainResponse :: Int -> Text -> UTCTime -> UTCTime -> GetDomainResponse
newGetDomainResponse
  Int
pHttpStatus_
  Text
pDomainName_
  UTCTime
pCreatedAt_
  UTCTime
pLastUpdatedAt_ =
    GetDomainResponse'
      { $sel:deadLetterQueueUrl:GetDomainResponse' :: Maybe Text
deadLetterQueueUrl =
          forall a. Maybe a
Prelude.Nothing,
        $sel:defaultEncryptionKey:GetDomainResponse' :: Maybe Text
defaultEncryptionKey = forall a. Maybe a
Prelude.Nothing,
        $sel:defaultExpirationDays:GetDomainResponse' :: Maybe Natural
defaultExpirationDays = forall a. Maybe a
Prelude.Nothing,
        $sel:matching:GetDomainResponse' :: Maybe MatchingResponse
matching = forall a. Maybe a
Prelude.Nothing,
        $sel:stats:GetDomainResponse' :: Maybe DomainStats
stats = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:GetDomainResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetDomainResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:domainName:GetDomainResponse' :: Text
domainName = Text
pDomainName_,
        $sel:createdAt:GetDomainResponse' :: POSIX
createdAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedAt_,
        $sel:lastUpdatedAt:GetDomainResponse' :: POSIX
lastUpdatedAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastUpdatedAt_
      }

-- | The URL of the SQS dead letter queue, which is used for reporting errors
-- associated with ingesting data from third party applications.
getDomainResponse_deadLetterQueueUrl :: Lens.Lens' GetDomainResponse (Prelude.Maybe Prelude.Text)
getDomainResponse_deadLetterQueueUrl :: Lens' GetDomainResponse (Maybe Text)
getDomainResponse_deadLetterQueueUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {Maybe Text
deadLetterQueueUrl :: Maybe Text
$sel:deadLetterQueueUrl:GetDomainResponse' :: GetDomainResponse -> Maybe Text
deadLetterQueueUrl} -> Maybe Text
deadLetterQueueUrl) (\s :: GetDomainResponse
s@GetDomainResponse' {} Maybe Text
a -> GetDomainResponse
s {$sel:deadLetterQueueUrl:GetDomainResponse' :: Maybe Text
deadLetterQueueUrl = Maybe Text
a} :: GetDomainResponse)

-- | The default encryption key, which is an AWS managed key, is used when no
-- specific type of encryption key is specified. It is used to encrypt all
-- data before it is placed in permanent or semi-permanent storage.
getDomainResponse_defaultEncryptionKey :: Lens.Lens' GetDomainResponse (Prelude.Maybe Prelude.Text)
getDomainResponse_defaultEncryptionKey :: Lens' GetDomainResponse (Maybe Text)
getDomainResponse_defaultEncryptionKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {Maybe Text
defaultEncryptionKey :: Maybe Text
$sel:defaultEncryptionKey:GetDomainResponse' :: GetDomainResponse -> Maybe Text
defaultEncryptionKey} -> Maybe Text
defaultEncryptionKey) (\s :: GetDomainResponse
s@GetDomainResponse' {} Maybe Text
a -> GetDomainResponse
s {$sel:defaultEncryptionKey:GetDomainResponse' :: Maybe Text
defaultEncryptionKey = Maybe Text
a} :: GetDomainResponse)

-- | The default number of days until the data within the domain expires.
getDomainResponse_defaultExpirationDays :: Lens.Lens' GetDomainResponse (Prelude.Maybe Prelude.Natural)
getDomainResponse_defaultExpirationDays :: Lens' GetDomainResponse (Maybe Natural)
getDomainResponse_defaultExpirationDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {Maybe Natural
defaultExpirationDays :: Maybe Natural
$sel:defaultExpirationDays:GetDomainResponse' :: GetDomainResponse -> Maybe Natural
defaultExpirationDays} -> Maybe Natural
defaultExpirationDays) (\s :: GetDomainResponse
s@GetDomainResponse' {} Maybe Natural
a -> GetDomainResponse
s {$sel:defaultExpirationDays:GetDomainResponse' :: Maybe Natural
defaultExpirationDays = Maybe Natural
a} :: GetDomainResponse)

-- | The process of matching duplicate profiles. If @Matching@ = @true@,
-- Amazon Connect Customer Profiles starts a weekly batch process called
-- Identity Resolution Job. If you do not specify a date and time for
-- Identity Resolution Job to run, by default it runs every Saturday at
-- 12AM UTC to detect duplicate profiles in your domains.
--
-- After the Identity Resolution Job completes, use the
-- <https://docs.aws.amazon.com/customerprofiles/latest/APIReference/API_GetMatches.html GetMatches>
-- API to return and review the results. Or, if you have configured
-- @ExportingConfig@ in the @MatchingRequest@, you can download the results
-- from S3.
getDomainResponse_matching :: Lens.Lens' GetDomainResponse (Prelude.Maybe MatchingResponse)
getDomainResponse_matching :: Lens' GetDomainResponse (Maybe MatchingResponse)
getDomainResponse_matching = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {Maybe MatchingResponse
matching :: Maybe MatchingResponse
$sel:matching:GetDomainResponse' :: GetDomainResponse -> Maybe MatchingResponse
matching} -> Maybe MatchingResponse
matching) (\s :: GetDomainResponse
s@GetDomainResponse' {} Maybe MatchingResponse
a -> GetDomainResponse
s {$sel:matching:GetDomainResponse' :: Maybe MatchingResponse
matching = Maybe MatchingResponse
a} :: GetDomainResponse)

-- | Usage-specific statistics about the domain.
getDomainResponse_stats :: Lens.Lens' GetDomainResponse (Prelude.Maybe DomainStats)
getDomainResponse_stats :: Lens' GetDomainResponse (Maybe DomainStats)
getDomainResponse_stats = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {Maybe DomainStats
stats :: Maybe DomainStats
$sel:stats:GetDomainResponse' :: GetDomainResponse -> Maybe DomainStats
stats} -> Maybe DomainStats
stats) (\s :: GetDomainResponse
s@GetDomainResponse' {} Maybe DomainStats
a -> GetDomainResponse
s {$sel:stats:GetDomainResponse' :: Maybe DomainStats
stats = Maybe DomainStats
a} :: GetDomainResponse)

-- | The tags used to organize, track, or control access for this resource.
getDomainResponse_tags :: Lens.Lens' GetDomainResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getDomainResponse_tags :: Lens' GetDomainResponse (Maybe (HashMap Text Text))
getDomainResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetDomainResponse' :: GetDomainResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetDomainResponse
s@GetDomainResponse' {} Maybe (HashMap Text Text)
a -> GetDomainResponse
s {$sel:tags:GetDomainResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetDomainResponse) 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 response's http status code.
getDomainResponse_httpStatus :: Lens.Lens' GetDomainResponse Prelude.Int
getDomainResponse_httpStatus :: Lens' GetDomainResponse Int
getDomainResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetDomainResponse' :: GetDomainResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetDomainResponse
s@GetDomainResponse' {} Int
a -> GetDomainResponse
s {$sel:httpStatus:GetDomainResponse' :: Int
httpStatus = Int
a} :: GetDomainResponse)

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

-- | The timestamp of when the domain was created.
getDomainResponse_createdAt :: Lens.Lens' GetDomainResponse Prelude.UTCTime
getDomainResponse_createdAt :: Lens' GetDomainResponse UTCTime
getDomainResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {POSIX
createdAt :: POSIX
$sel:createdAt:GetDomainResponse' :: GetDomainResponse -> POSIX
createdAt} -> POSIX
createdAt) (\s :: GetDomainResponse
s@GetDomainResponse' {} POSIX
a -> GetDomainResponse
s {$sel:createdAt:GetDomainResponse' :: POSIX
createdAt = POSIX
a} :: GetDomainResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The timestamp of when the domain was most recently edited.
getDomainResponse_lastUpdatedAt :: Lens.Lens' GetDomainResponse Prelude.UTCTime
getDomainResponse_lastUpdatedAt :: Lens' GetDomainResponse UTCTime
getDomainResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDomainResponse' {POSIX
lastUpdatedAt :: POSIX
$sel:lastUpdatedAt:GetDomainResponse' :: GetDomainResponse -> POSIX
lastUpdatedAt} -> POSIX
lastUpdatedAt) (\s :: GetDomainResponse
s@GetDomainResponse' {} POSIX
a -> GetDomainResponse
s {$sel:lastUpdatedAt:GetDomainResponse' :: POSIX
lastUpdatedAt = POSIX
a} :: GetDomainResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData GetDomainResponse where
  rnf :: GetDomainResponse -> ()
rnf GetDomainResponse' {Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe DomainStats
Maybe MatchingResponse
Text
POSIX
lastUpdatedAt :: POSIX
createdAt :: POSIX
domainName :: Text
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
stats :: Maybe DomainStats
matching :: Maybe MatchingResponse
defaultExpirationDays :: Maybe Natural
defaultEncryptionKey :: Maybe Text
deadLetterQueueUrl :: Maybe Text
$sel:lastUpdatedAt:GetDomainResponse' :: GetDomainResponse -> POSIX
$sel:createdAt:GetDomainResponse' :: GetDomainResponse -> POSIX
$sel:domainName:GetDomainResponse' :: GetDomainResponse -> Text
$sel:httpStatus:GetDomainResponse' :: GetDomainResponse -> Int
$sel:tags:GetDomainResponse' :: GetDomainResponse -> Maybe (HashMap Text Text)
$sel:stats:GetDomainResponse' :: GetDomainResponse -> Maybe DomainStats
$sel:matching:GetDomainResponse' :: GetDomainResponse -> Maybe MatchingResponse
$sel:defaultExpirationDays:GetDomainResponse' :: GetDomainResponse -> Maybe Natural
$sel:defaultEncryptionKey:GetDomainResponse' :: GetDomainResponse -> Maybe Text
$sel:deadLetterQueueUrl:GetDomainResponse' :: GetDomainResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deadLetterQueueUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
defaultEncryptionKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
defaultExpirationDays
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MatchingResponse
matching
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DomainStats
stats
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
lastUpdatedAt