{-# 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.CreateDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a domain, which is a container for all customer data, such as
-- customer profile attributes, object types, profile keys, and encryption
-- keys. You can create multiple domains, and each domain can have multiple
-- third-party integrations.
--
-- Each Amazon Connect instance can be associated with only one domain.
-- Multiple Amazon Connect instances can be associated with one domain.
--
-- Use this API or
-- <https://docs.aws.amazon.com/customerprofiles/latest/APIReference/API_UpdateDomain.html UpdateDomain>
-- 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.
module Amazonka.CustomerProfiles.CreateDomain
  ( -- * Creating a Request
    CreateDomain (..),
    newCreateDomain,

    -- * Request Lenses
    createDomain_deadLetterQueueUrl,
    createDomain_defaultEncryptionKey,
    createDomain_matching,
    createDomain_tags,
    createDomain_domainName,
    createDomain_defaultExpirationDays,

    -- * Destructuring the Response
    CreateDomainResponse (..),
    newCreateDomainResponse,

    -- * Response Lenses
    createDomainResponse_deadLetterQueueUrl,
    createDomainResponse_defaultEncryptionKey,
    createDomainResponse_matching,
    createDomainResponse_tags,
    createDomainResponse_httpStatus,
    createDomainResponse_domainName,
    createDomainResponse_defaultExpirationDays,
    createDomainResponse_createdAt,
    createDomainResponse_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:/ 'newCreateDomain' smart constructor.
data CreateDomain = CreateDomain'
  { -- | The URL of the SQS dead letter queue, which is used for reporting errors
    -- associated with ingesting data from third party applications. 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.
    CreateDomain -> 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.
    CreateDomain -> Maybe Text
defaultEncryptionKey :: Prelude.Maybe Prelude.Text,
    -- | 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.
    CreateDomain -> Maybe MatchingRequest
matching :: Prelude.Maybe MatchingRequest,
    -- | The tags used to organize, track, or control access for this resource.
    CreateDomain -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The unique name of the domain.
    CreateDomain -> Text
domainName :: Prelude.Text,
    -- | The default number of days until the data within the domain expires.
    CreateDomain -> Natural
defaultExpirationDays :: Prelude.Natural
  }
  deriving (CreateDomain -> CreateDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDomain -> CreateDomain -> Bool
$c/= :: CreateDomain -> CreateDomain -> Bool
== :: CreateDomain -> CreateDomain -> Bool
$c== :: CreateDomain -> CreateDomain -> Bool
Prelude.Eq, ReadPrec [CreateDomain]
ReadPrec CreateDomain
Int -> ReadS CreateDomain
ReadS [CreateDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDomain]
$creadListPrec :: ReadPrec [CreateDomain]
readPrec :: ReadPrec CreateDomain
$creadPrec :: ReadPrec CreateDomain
readList :: ReadS [CreateDomain]
$creadList :: ReadS [CreateDomain]
readsPrec :: Int -> ReadS CreateDomain
$creadsPrec :: Int -> ReadS CreateDomain
Prelude.Read, Int -> CreateDomain -> ShowS
[CreateDomain] -> ShowS
CreateDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDomain] -> ShowS
$cshowList :: [CreateDomain] -> ShowS
show :: CreateDomain -> String
$cshow :: CreateDomain -> String
showsPrec :: Int -> CreateDomain -> ShowS
$cshowsPrec :: Int -> CreateDomain -> ShowS
Prelude.Show, forall x. Rep CreateDomain x -> CreateDomain
forall x. CreateDomain -> Rep CreateDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDomain x -> CreateDomain
$cfrom :: forall x. CreateDomain -> Rep CreateDomain x
Prelude.Generic)

-- |
-- Create a value of 'CreateDomain' 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', 'createDomain_deadLetterQueueUrl' - The URL of the SQS dead letter queue, which is used for reporting errors
-- associated with ingesting data from third party applications. 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', 'createDomain_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.
--
-- 'matching', 'createDomain_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', 'createDomain_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'domainName', 'createDomain_domainName' - The unique name of the domain.
--
-- 'defaultExpirationDays', 'createDomain_defaultExpirationDays' - The default number of days until the data within the domain expires.
newCreateDomain ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'defaultExpirationDays'
  Prelude.Natural ->
  CreateDomain
newCreateDomain :: Text -> Natural -> CreateDomain
newCreateDomain Text
pDomainName_ Natural
pDefaultExpirationDays_ =
  CreateDomain'
    { $sel:deadLetterQueueUrl:CreateDomain' :: Maybe Text
deadLetterQueueUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultEncryptionKey:CreateDomain' :: Maybe Text
defaultEncryptionKey = forall a. Maybe a
Prelude.Nothing,
      $sel:matching:CreateDomain' :: Maybe MatchingRequest
matching = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateDomain' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:CreateDomain' :: Text
domainName = Text
pDomainName_,
      $sel:defaultExpirationDays:CreateDomain' :: Natural
defaultExpirationDays = Natural
pDefaultExpirationDays_
    }

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

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

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

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

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

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

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

instance Data.ToHeaders CreateDomain where
  toHeaders :: CreateDomain -> 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 CreateDomain where
  toJSON :: CreateDomain -> Value
toJSON CreateDomain' {Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe MatchingRequest
Text
defaultExpirationDays :: Natural
domainName :: Text
tags :: Maybe (HashMap Text Text)
matching :: Maybe MatchingRequest
defaultEncryptionKey :: Maybe Text
deadLetterQueueUrl :: Maybe Text
$sel:defaultExpirationDays:CreateDomain' :: CreateDomain -> Natural
$sel:domainName:CreateDomain' :: CreateDomain -> Text
$sel:tags:CreateDomain' :: CreateDomain -> Maybe (HashMap Text Text)
$sel:matching:CreateDomain' :: CreateDomain -> Maybe MatchingRequest
$sel:defaultEncryptionKey:CreateDomain' :: CreateDomain -> Maybe Text
$sel:deadLetterQueueUrl:CreateDomain' :: CreateDomain -> 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
"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,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"DefaultExpirationDays"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
defaultExpirationDays
              )
          ]
      )

instance Data.ToPath CreateDomain where
  toPath :: CreateDomain -> ByteString
toPath CreateDomain' {Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe MatchingRequest
Text
defaultExpirationDays :: Natural
domainName :: Text
tags :: Maybe (HashMap Text Text)
matching :: Maybe MatchingRequest
defaultEncryptionKey :: Maybe Text
deadLetterQueueUrl :: Maybe Text
$sel:defaultExpirationDays:CreateDomain' :: CreateDomain -> Natural
$sel:domainName:CreateDomain' :: CreateDomain -> Text
$sel:tags:CreateDomain' :: CreateDomain -> Maybe (HashMap Text Text)
$sel:matching:CreateDomain' :: CreateDomain -> Maybe MatchingRequest
$sel:defaultEncryptionKey:CreateDomain' :: CreateDomain -> Maybe Text
$sel:deadLetterQueueUrl:CreateDomain' :: CreateDomain -> 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 CreateDomain where
  toQuery :: CreateDomain -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

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

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

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

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

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

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

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