{-# 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.UpdateDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the properties of a domain, including creating or selecting a
-- dead letter queue or an encryption key.
--
-- After a domain is created, the name can’t be changed.
--
-- Use this API or
-- <https://docs.aws.amazon.com/customerprofiles/latest/APIReference/API_CreateDomain.html CreateDomain>
-- to enable
-- <https://docs.aws.amazon.com/customerprofiles/latest/APIReference/API_GetMatches.html identity resolution>:
-- set @Matching@ to true.
--
-- To prevent cross-service impersonation when you call this API, see
-- <https://docs.aws.amazon.com/connect/latest/adminguide/cross-service-confused-deputy-prevention.html Cross-service confused deputy prevention>
-- for sample policies that you should apply.
--
-- To add or remove tags on an existing Domain, see
-- <https://docs.aws.amazon.com/customerprofiles/latest/APIReference/API_TagResource.html TagResource>\/<https://docs.aws.amazon.com/customerprofiles/latest/APIReference/API_UntagResource.html UntagResource>.
module Amazonka.CustomerProfiles.UpdateDomain
  ( -- * Creating a Request
    UpdateDomain (..),
    newUpdateDomain,

    -- * Request Lenses
    updateDomain_deadLetterQueueUrl,
    updateDomain_defaultEncryptionKey,
    updateDomain_defaultExpirationDays,
    updateDomain_matching,
    updateDomain_tags,
    updateDomain_domainName,

    -- * Destructuring the Response
    UpdateDomainResponse (..),
    newUpdateDomainResponse,

    -- * Response Lenses
    updateDomainResponse_deadLetterQueueUrl,
    updateDomainResponse_defaultEncryptionKey,
    updateDomainResponse_defaultExpirationDays,
    updateDomainResponse_matching,
    updateDomainResponse_tags,
    updateDomainResponse_httpStatus,
    updateDomainResponse_domainName,
    updateDomainResponse_createdAt,
    updateDomainResponse_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:/ 'newUpdateDomain' smart constructor.
data UpdateDomain = UpdateDomain'
  { -- | The URL of the SQS dead letter queue, which is used for reporting errors
    -- associated with ingesting data from third party applications. If
    -- specified as an empty string, it will clear any existing value. You must
    -- set up a policy on the DeadLetterQueue for the SendMessage operation to
    -- enable Amazon Connect Customer Profiles to send messages to the
    -- DeadLetterQueue.
    UpdateDomain -> 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. If
    -- specified as an empty string, it will clear any existing value.
    UpdateDomain -> Maybe Text
defaultEncryptionKey :: Prelude.Maybe Prelude.Text,
    -- | The default number of days until the data within the domain expires.
    UpdateDomain -> 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.
    UpdateDomain -> Maybe MatchingRequest
matching :: Prelude.Maybe MatchingRequest,
    -- | The tags used to organize, track, or control access for this resource.
    UpdateDomain -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The unique name of the domain.
    UpdateDomain -> Text
domainName :: Prelude.Text
  }
  deriving (UpdateDomain -> UpdateDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDomain -> UpdateDomain -> Bool
$c/= :: UpdateDomain -> UpdateDomain -> Bool
== :: UpdateDomain -> UpdateDomain -> Bool
$c== :: UpdateDomain -> UpdateDomain -> Bool
Prelude.Eq, ReadPrec [UpdateDomain]
ReadPrec UpdateDomain
Int -> ReadS UpdateDomain
ReadS [UpdateDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDomain]
$creadListPrec :: ReadPrec [UpdateDomain]
readPrec :: ReadPrec UpdateDomain
$creadPrec :: ReadPrec UpdateDomain
readList :: ReadS [UpdateDomain]
$creadList :: ReadS [UpdateDomain]
readsPrec :: Int -> ReadS UpdateDomain
$creadsPrec :: Int -> ReadS UpdateDomain
Prelude.Read, Int -> UpdateDomain -> ShowS
[UpdateDomain] -> ShowS
UpdateDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDomain] -> ShowS
$cshowList :: [UpdateDomain] -> ShowS
show :: UpdateDomain -> String
$cshow :: UpdateDomain -> String
showsPrec :: Int -> UpdateDomain -> ShowS
$cshowsPrec :: Int -> UpdateDomain -> ShowS
Prelude.Show, forall x. Rep UpdateDomain x -> UpdateDomain
forall x. UpdateDomain -> Rep UpdateDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDomain x -> UpdateDomain
$cfrom :: forall x. UpdateDomain -> Rep UpdateDomain x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDomain' 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', 'updateDomain_deadLetterQueueUrl' - The URL of the SQS dead letter queue, which is used for reporting errors
-- associated with ingesting data from third party applications. If
-- specified as an empty string, it will clear any existing value. You must
-- set up a policy on the DeadLetterQueue for the SendMessage operation to
-- enable Amazon Connect Customer Profiles to send messages to the
-- DeadLetterQueue.
--
-- 'defaultEncryptionKey', 'updateDomain_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. If
-- specified as an empty string, it will clear any existing value.
--
-- 'defaultExpirationDays', 'updateDomain_defaultExpirationDays' - The default number of days until the data within the domain expires.
--
-- 'matching', 'updateDomain_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.
--
-- 'tags', 'updateDomain_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'domainName', 'updateDomain_domainName' - The unique name of the domain.
newUpdateDomain ::
  -- | 'domainName'
  Prelude.Text ->
  UpdateDomain
newUpdateDomain :: Text -> UpdateDomain
newUpdateDomain Text
pDomainName_ =
  UpdateDomain'
    { $sel:deadLetterQueueUrl:UpdateDomain' :: Maybe Text
deadLetterQueueUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultEncryptionKey:UpdateDomain' :: Maybe Text
defaultEncryptionKey = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultExpirationDays:UpdateDomain' :: Maybe Natural
defaultExpirationDays = forall a. Maybe a
Prelude.Nothing,
      $sel:matching:UpdateDomain' :: Maybe MatchingRequest
matching = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:UpdateDomain' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:UpdateDomain' :: Text
domainName = Text
pDomainName_
    }

-- | The URL of the SQS dead letter queue, which is used for reporting errors
-- associated with ingesting data from third party applications. If
-- specified as an empty string, it will clear any existing value. You must
-- set up a policy on the DeadLetterQueue for the SendMessage operation to
-- enable Amazon Connect Customer Profiles to send messages to the
-- DeadLetterQueue.
updateDomain_deadLetterQueueUrl :: Lens.Lens' UpdateDomain (Prelude.Maybe Prelude.Text)
updateDomain_deadLetterQueueUrl :: Lens' UpdateDomain (Maybe Text)
updateDomain_deadLetterQueueUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {Maybe Text
deadLetterQueueUrl :: Maybe Text
$sel:deadLetterQueueUrl:UpdateDomain' :: UpdateDomain -> Maybe Text
deadLetterQueueUrl} -> Maybe Text
deadLetterQueueUrl) (\s :: UpdateDomain
s@UpdateDomain' {} Maybe Text
a -> UpdateDomain
s {$sel:deadLetterQueueUrl:UpdateDomain' :: Maybe Text
deadLetterQueueUrl = Maybe Text
a} :: UpdateDomain)

-- | 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. If
-- specified as an empty string, it will clear any existing value.
updateDomain_defaultEncryptionKey :: Lens.Lens' UpdateDomain (Prelude.Maybe Prelude.Text)
updateDomain_defaultEncryptionKey :: Lens' UpdateDomain (Maybe Text)
updateDomain_defaultEncryptionKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {Maybe Text
defaultEncryptionKey :: Maybe Text
$sel:defaultEncryptionKey:UpdateDomain' :: UpdateDomain -> Maybe Text
defaultEncryptionKey} -> Maybe Text
defaultEncryptionKey) (\s :: UpdateDomain
s@UpdateDomain' {} Maybe Text
a -> UpdateDomain
s {$sel:defaultEncryptionKey:UpdateDomain' :: Maybe Text
defaultEncryptionKey = Maybe Text
a} :: UpdateDomain)

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

-- | 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.
updateDomain_matching :: Lens.Lens' UpdateDomain (Prelude.Maybe MatchingRequest)
updateDomain_matching :: Lens' UpdateDomain (Maybe MatchingRequest)
updateDomain_matching = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {Maybe MatchingRequest
matching :: Maybe MatchingRequest
$sel:matching:UpdateDomain' :: UpdateDomain -> Maybe MatchingRequest
matching} -> Maybe MatchingRequest
matching) (\s :: UpdateDomain
s@UpdateDomain' {} Maybe MatchingRequest
a -> UpdateDomain
s {$sel:matching:UpdateDomain' :: Maybe MatchingRequest
matching = Maybe MatchingRequest
a} :: UpdateDomain)

-- | The tags used to organize, track, or control access for this resource.
updateDomain_tags :: Lens.Lens' UpdateDomain (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
updateDomain_tags :: Lens' UpdateDomain (Maybe (HashMap Text Text))
updateDomain_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:UpdateDomain' :: UpdateDomain -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: UpdateDomain
s@UpdateDomain' {} Maybe (HashMap Text Text)
a -> UpdateDomain
s {$sel:tags:UpdateDomain' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: UpdateDomain) 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 unique name of the domain.
updateDomain_domainName :: Lens.Lens' UpdateDomain Prelude.Text
updateDomain_domainName :: Lens' UpdateDomain Text
updateDomain_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomain' {Text
domainName :: Text
$sel:domainName:UpdateDomain' :: UpdateDomain -> Text
domainName} -> Text
domainName) (\s :: UpdateDomain
s@UpdateDomain' {} Text
a -> UpdateDomain
s {$sel:domainName:UpdateDomain' :: Text
domainName = Text
a} :: UpdateDomain)

instance Core.AWSRequest UpdateDomain where
  type AWSResponse UpdateDomain = UpdateDomainResponse
  request :: (Service -> Service) -> UpdateDomain -> Request UpdateDomain
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateDomain
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateDomain)))
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 (HashMap Text Text)
-> Int
-> Text
-> POSIX
-> POSIX
-> UpdateDomainResponse
UpdateDomainResponse'
            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
"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 UpdateDomain where
  hashWithSalt :: Int -> UpdateDomain -> Int
hashWithSalt Int
_salt UpdateDomain' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe MatchingRequest
Text
domainName :: Text
tags :: Maybe (HashMap Text Text)
matching :: Maybe MatchingRequest
defaultExpirationDays :: Maybe Natural
defaultEncryptionKey :: Maybe Text
deadLetterQueueUrl :: Maybe Text
$sel:domainName:UpdateDomain' :: UpdateDomain -> Text
$sel:tags:UpdateDomain' :: UpdateDomain -> Maybe (HashMap Text Text)
$sel:matching:UpdateDomain' :: UpdateDomain -> Maybe MatchingRequest
$sel:defaultExpirationDays:UpdateDomain' :: UpdateDomain -> Maybe Natural
$sel:defaultEncryptionKey:UpdateDomain' :: UpdateDomain -> Maybe Text
$sel:deadLetterQueueUrl:UpdateDomain' :: UpdateDomain -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deadLetterQueueUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
defaultEncryptionKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
defaultExpirationDays
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MatchingRequest
matching
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData UpdateDomain where
  rnf :: UpdateDomain -> ()
rnf UpdateDomain' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe MatchingRequest
Text
domainName :: Text
tags :: Maybe (HashMap Text Text)
matching :: Maybe MatchingRequest
defaultExpirationDays :: Maybe Natural
defaultEncryptionKey :: Maybe Text
deadLetterQueueUrl :: Maybe Text
$sel:domainName:UpdateDomain' :: UpdateDomain -> Text
$sel:tags:UpdateDomain' :: UpdateDomain -> Maybe (HashMap Text Text)
$sel:matching:UpdateDomain' :: UpdateDomain -> Maybe MatchingRequest
$sel:defaultExpirationDays:UpdateDomain' :: UpdateDomain -> Maybe Natural
$sel:defaultEncryptionKey:UpdateDomain' :: UpdateDomain -> Maybe Text
$sel:deadLetterQueueUrl:UpdateDomain' :: UpdateDomain -> 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 MatchingRequest
matching
      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 Text
domainName

instance Data.ToHeaders UpdateDomain where
  toHeaders :: UpdateDomain -> 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 UpdateDomain where
  toJSON :: UpdateDomain -> Value
toJSON UpdateDomain' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe MatchingRequest
Text
domainName :: Text
tags :: Maybe (HashMap Text Text)
matching :: Maybe MatchingRequest
defaultExpirationDays :: Maybe Natural
defaultEncryptionKey :: Maybe Text
deadLetterQueueUrl :: Maybe Text
$sel:domainName:UpdateDomain' :: UpdateDomain -> Text
$sel:tags:UpdateDomain' :: UpdateDomain -> Maybe (HashMap Text Text)
$sel:matching:UpdateDomain' :: UpdateDomain -> Maybe MatchingRequest
$sel:defaultExpirationDays:UpdateDomain' :: UpdateDomain -> Maybe Natural
$sel:defaultEncryptionKey:UpdateDomain' :: UpdateDomain -> Maybe Text
$sel:deadLetterQueueUrl:UpdateDomain' :: UpdateDomain -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DeadLetterQueueUrl" 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
deadLetterQueueUrl,
            (Key
"DefaultEncryptionKey" 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
defaultEncryptionKey,
            (Key
"DefaultExpirationDays" 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 Natural
defaultExpirationDays,
            (Key
"Matching" 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 MatchingRequest
matching,
            (Key
"Tags" 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 (HashMap Text Text)
tags
          ]
      )

instance Data.ToPath UpdateDomain where
  toPath :: UpdateDomain -> ByteString
toPath UpdateDomain' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe MatchingRequest
Text
domainName :: Text
tags :: Maybe (HashMap Text Text)
matching :: Maybe MatchingRequest
defaultExpirationDays :: Maybe Natural
defaultEncryptionKey :: Maybe Text
deadLetterQueueUrl :: Maybe Text
$sel:domainName:UpdateDomain' :: UpdateDomain -> Text
$sel:tags:UpdateDomain' :: UpdateDomain -> Maybe (HashMap Text Text)
$sel:matching:UpdateDomain' :: UpdateDomain -> Maybe MatchingRequest
$sel:defaultExpirationDays:UpdateDomain' :: UpdateDomain -> Maybe Natural
$sel:defaultEncryptionKey:UpdateDomain' :: UpdateDomain -> Maybe Text
$sel:deadLetterQueueUrl:UpdateDomain' :: UpdateDomain -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/domains/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName]

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

-- | /See:/ 'newUpdateDomainResponse' smart constructor.
data UpdateDomainResponse = UpdateDomainResponse'
  { -- | The URL of the SQS dead letter queue, which is used for reporting errors
    -- associated with ingesting data from third party applications.
    UpdateDomainResponse -> 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.
    UpdateDomainResponse -> Maybe Text
defaultEncryptionKey :: Prelude.Maybe Prelude.Text,
    -- | The default number of days until the data within the domain expires.
    UpdateDomainResponse -> 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.
    UpdateDomainResponse -> Maybe MatchingResponse
matching :: Prelude.Maybe MatchingResponse,
    -- | The tags used to organize, track, or control access for this resource.
    UpdateDomainResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    UpdateDomainResponse -> Int
httpStatus :: Prelude.Int,
    -- | The unique name of the domain.
    UpdateDomainResponse -> Text
domainName :: Prelude.Text,
    -- | The timestamp of when the domain was created.
    UpdateDomainResponse -> POSIX
createdAt :: Data.POSIX,
    -- | The timestamp of when the domain was most recently edited.
    UpdateDomainResponse -> POSIX
lastUpdatedAt :: Data.POSIX
  }
  deriving (UpdateDomainResponse -> UpdateDomainResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDomainResponse -> UpdateDomainResponse -> Bool
$c/= :: UpdateDomainResponse -> UpdateDomainResponse -> Bool
== :: UpdateDomainResponse -> UpdateDomainResponse -> Bool
$c== :: UpdateDomainResponse -> UpdateDomainResponse -> Bool
Prelude.Eq, ReadPrec [UpdateDomainResponse]
ReadPrec UpdateDomainResponse
Int -> ReadS UpdateDomainResponse
ReadS [UpdateDomainResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDomainResponse]
$creadListPrec :: ReadPrec [UpdateDomainResponse]
readPrec :: ReadPrec UpdateDomainResponse
$creadPrec :: ReadPrec UpdateDomainResponse
readList :: ReadS [UpdateDomainResponse]
$creadList :: ReadS [UpdateDomainResponse]
readsPrec :: Int -> ReadS UpdateDomainResponse
$creadsPrec :: Int -> ReadS UpdateDomainResponse
Prelude.Read, Int -> UpdateDomainResponse -> ShowS
[UpdateDomainResponse] -> ShowS
UpdateDomainResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDomainResponse] -> ShowS
$cshowList :: [UpdateDomainResponse] -> ShowS
show :: UpdateDomainResponse -> String
$cshow :: UpdateDomainResponse -> String
showsPrec :: Int -> UpdateDomainResponse -> ShowS
$cshowsPrec :: Int -> UpdateDomainResponse -> ShowS
Prelude.Show, forall x. Rep UpdateDomainResponse x -> UpdateDomainResponse
forall x. UpdateDomainResponse -> Rep UpdateDomainResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDomainResponse x -> UpdateDomainResponse
$cfrom :: forall x. UpdateDomainResponse -> Rep UpdateDomainResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDomainResponse' 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', 'updateDomainResponse_deadLetterQueueUrl' - The URL of the SQS dead letter queue, which is used for reporting errors
-- associated with ingesting data from third party applications.
--
-- 'defaultEncryptionKey', 'updateDomainResponse_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', 'updateDomainResponse_defaultExpirationDays' - The default number of days until the data within the domain expires.
--
-- 'matching', 'updateDomainResponse_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.
--
-- 'tags', 'updateDomainResponse_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'httpStatus', 'updateDomainResponse_httpStatus' - The response's http status code.
--
-- 'domainName', 'updateDomainResponse_domainName' - The unique name of the domain.
--
-- 'createdAt', 'updateDomainResponse_createdAt' - The timestamp of when the domain was created.
--
-- 'lastUpdatedAt', 'updateDomainResponse_lastUpdatedAt' - The timestamp of when the domain was most recently edited.
newUpdateDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'domainName'
  Prelude.Text ->
  -- | 'createdAt'
  Prelude.UTCTime ->
  -- | 'lastUpdatedAt'
  Prelude.UTCTime ->
  UpdateDomainResponse
newUpdateDomainResponse :: Int -> Text -> UTCTime -> UTCTime -> UpdateDomainResponse
newUpdateDomainResponse
  Int
pHttpStatus_
  Text
pDomainName_
  UTCTime
pCreatedAt_
  UTCTime
pLastUpdatedAt_ =
    UpdateDomainResponse'
      { $sel:deadLetterQueueUrl:UpdateDomainResponse' :: Maybe Text
deadLetterQueueUrl =
          forall a. Maybe a
Prelude.Nothing,
        $sel:defaultEncryptionKey:UpdateDomainResponse' :: Maybe Text
defaultEncryptionKey = forall a. Maybe a
Prelude.Nothing,
        $sel:defaultExpirationDays:UpdateDomainResponse' :: Maybe Natural
defaultExpirationDays = forall a. Maybe a
Prelude.Nothing,
        $sel:matching:UpdateDomainResponse' :: Maybe MatchingResponse
matching = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:UpdateDomainResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:UpdateDomainResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:domainName:UpdateDomainResponse' :: Text
domainName = Text
pDomainName_,
        $sel:createdAt:UpdateDomainResponse' :: POSIX
createdAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedAt_,
        $sel:lastUpdatedAt:UpdateDomainResponse' :: 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.
updateDomainResponse_deadLetterQueueUrl :: Lens.Lens' UpdateDomainResponse (Prelude.Maybe Prelude.Text)
updateDomainResponse_deadLetterQueueUrl :: Lens' UpdateDomainResponse (Maybe Text)
updateDomainResponse_deadLetterQueueUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomainResponse' {Maybe Text
deadLetterQueueUrl :: Maybe Text
$sel:deadLetterQueueUrl:UpdateDomainResponse' :: UpdateDomainResponse -> Maybe Text
deadLetterQueueUrl} -> Maybe Text
deadLetterQueueUrl) (\s :: UpdateDomainResponse
s@UpdateDomainResponse' {} Maybe Text
a -> UpdateDomainResponse
s {$sel:deadLetterQueueUrl:UpdateDomainResponse' :: Maybe Text
deadLetterQueueUrl = Maybe Text
a} :: UpdateDomainResponse)

-- | 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.
updateDomainResponse_defaultEncryptionKey :: Lens.Lens' UpdateDomainResponse (Prelude.Maybe Prelude.Text)
updateDomainResponse_defaultEncryptionKey :: Lens' UpdateDomainResponse (Maybe Text)
updateDomainResponse_defaultEncryptionKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomainResponse' {Maybe Text
defaultEncryptionKey :: Maybe Text
$sel:defaultEncryptionKey:UpdateDomainResponse' :: UpdateDomainResponse -> Maybe Text
defaultEncryptionKey} -> Maybe Text
defaultEncryptionKey) (\s :: UpdateDomainResponse
s@UpdateDomainResponse' {} Maybe Text
a -> UpdateDomainResponse
s {$sel:defaultEncryptionKey:UpdateDomainResponse' :: Maybe Text
defaultEncryptionKey = Maybe Text
a} :: UpdateDomainResponse)

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

-- | 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.
updateDomainResponse_matching :: Lens.Lens' UpdateDomainResponse (Prelude.Maybe MatchingResponse)
updateDomainResponse_matching :: Lens' UpdateDomainResponse (Maybe MatchingResponse)
updateDomainResponse_matching = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomainResponse' {Maybe MatchingResponse
matching :: Maybe MatchingResponse
$sel:matching:UpdateDomainResponse' :: UpdateDomainResponse -> Maybe MatchingResponse
matching} -> Maybe MatchingResponse
matching) (\s :: UpdateDomainResponse
s@UpdateDomainResponse' {} Maybe MatchingResponse
a -> UpdateDomainResponse
s {$sel:matching:UpdateDomainResponse' :: Maybe MatchingResponse
matching = Maybe MatchingResponse
a} :: UpdateDomainResponse)

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

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

-- | The timestamp of when the domain was created.
updateDomainResponse_createdAt :: Lens.Lens' UpdateDomainResponse Prelude.UTCTime
updateDomainResponse_createdAt :: Lens' UpdateDomainResponse UTCTime
updateDomainResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomainResponse' {POSIX
createdAt :: POSIX
$sel:createdAt:UpdateDomainResponse' :: UpdateDomainResponse -> POSIX
createdAt} -> POSIX
createdAt) (\s :: UpdateDomainResponse
s@UpdateDomainResponse' {} POSIX
a -> UpdateDomainResponse
s {$sel:createdAt:UpdateDomainResponse' :: POSIX
createdAt = POSIX
a} :: UpdateDomainResponse) 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.
updateDomainResponse_lastUpdatedAt :: Lens.Lens' UpdateDomainResponse Prelude.UTCTime
updateDomainResponse_lastUpdatedAt :: Lens' UpdateDomainResponse UTCTime
updateDomainResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDomainResponse' {POSIX
lastUpdatedAt :: POSIX
$sel:lastUpdatedAt:UpdateDomainResponse' :: UpdateDomainResponse -> POSIX
lastUpdatedAt} -> POSIX
lastUpdatedAt) (\s :: UpdateDomainResponse
s@UpdateDomainResponse' {} POSIX
a -> UpdateDomainResponse
s {$sel:lastUpdatedAt:UpdateDomainResponse' :: POSIX
lastUpdatedAt = POSIX
a} :: UpdateDomainResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData UpdateDomainResponse where
  rnf :: UpdateDomainResponse -> ()
rnf UpdateDomainResponse' {Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe MatchingResponse
Text
POSIX
lastUpdatedAt :: POSIX
createdAt :: POSIX
domainName :: Text
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
matching :: Maybe MatchingResponse
defaultExpirationDays :: Maybe Natural
defaultEncryptionKey :: Maybe Text
deadLetterQueueUrl :: Maybe Text
$sel:lastUpdatedAt:UpdateDomainResponse' :: UpdateDomainResponse -> POSIX
$sel:createdAt:UpdateDomainResponse' :: UpdateDomainResponse -> POSIX
$sel:domainName:UpdateDomainResponse' :: UpdateDomainResponse -> Text
$sel:httpStatus:UpdateDomainResponse' :: UpdateDomainResponse -> Int
$sel:tags:UpdateDomainResponse' :: UpdateDomainResponse -> Maybe (HashMap Text Text)
$sel:matching:UpdateDomainResponse' :: UpdateDomainResponse -> Maybe MatchingResponse
$sel:defaultExpirationDays:UpdateDomainResponse' :: UpdateDomainResponse -> Maybe Natural
$sel:defaultEncryptionKey:UpdateDomainResponse' :: UpdateDomainResponse -> Maybe Text
$sel:deadLetterQueueUrl:UpdateDomainResponse' :: UpdateDomainResponse -> 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 (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