{-# 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.SESV2.CreateEmailIdentity
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts the process of verifying an email identity. An /identity/ is an
-- email address or domain that you use when you send email. Before you can
-- use an identity to send email, you first have to verify it. By verifying
-- an identity, you demonstrate that you\'re the owner of the identity, and
-- that you\'ve given Amazon SES API v2 permission to send email from the
-- identity.
--
-- When you verify an email address, Amazon SES sends an email to the
-- address. Your email address is verified as soon as you follow the link
-- in the verification email.
--
-- When you verify a domain without specifying the @DkimSigningAttributes@
-- object, this operation provides a set of DKIM tokens. You can convert
-- these tokens into CNAME records, which you then add to the DNS
-- configuration for your domain. Your domain is verified when Amazon SES
-- detects these records in the DNS configuration for your domain. This
-- verification method is known as
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/easy-dkim.html Easy DKIM>.
--
-- Alternatively, you can perform the verification process by providing
-- your own public-private key pair. This verification method is known as
-- Bring Your Own DKIM (BYODKIM). To use BYODKIM, your call to the
-- @CreateEmailIdentity@ operation has to include the
-- @DkimSigningAttributes@ object. When you specify this object, you
-- provide a selector (a component of the DNS record name that identifies
-- the public key to use for DKIM authentication) and a private key.
--
-- When you verify a domain, this operation provides a set of DKIM tokens,
-- which you can convert into CNAME tokens. You add these CNAME tokens to
-- the DNS configuration for your domain. Your domain is verified when
-- Amazon SES detects these records in the DNS configuration for your
-- domain. For some DNS providers, it can take 72 hours or more to complete
-- the domain verification process.
--
-- Additionally, you can associate an existing configuration set with the
-- email identity that you\'re verifying.
module Amazonka.SESV2.CreateEmailIdentity
  ( -- * Creating a Request
    CreateEmailIdentity (..),
    newCreateEmailIdentity,

    -- * Request Lenses
    createEmailIdentity_configurationSetName,
    createEmailIdentity_dkimSigningAttributes,
    createEmailIdentity_tags,
    createEmailIdentity_emailIdentity,

    -- * Destructuring the Response
    CreateEmailIdentityResponse (..),
    newCreateEmailIdentityResponse,

    -- * Response Lenses
    createEmailIdentityResponse_dkimAttributes,
    createEmailIdentityResponse_identityType,
    createEmailIdentityResponse_verifiedForSendingStatus,
    createEmailIdentityResponse_httpStatus,
  )
where

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

-- | A request to begin the verification process for an email identity (an
-- email address or domain).
--
-- /See:/ 'newCreateEmailIdentity' smart constructor.
data CreateEmailIdentity = CreateEmailIdentity'
  { -- | The configuration set to use by default when sending from this identity.
    -- Note that any configuration set defined in the email sending request
    -- takes precedence.
    CreateEmailIdentity -> Maybe Text
configurationSetName :: Prelude.Maybe Prelude.Text,
    -- | If your request includes this object, Amazon SES configures the identity
    -- to use Bring Your Own DKIM (BYODKIM) for DKIM authentication purposes,
    -- or, configures the key length to be used for
    -- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/easy-dkim.html Easy DKIM>.
    --
    -- You can only specify this object if the email identity is a domain, as
    -- opposed to an address.
    CreateEmailIdentity -> Maybe DkimSigningAttributes
dkimSigningAttributes :: Prelude.Maybe DkimSigningAttributes,
    -- | An array of objects that define the tags (keys and values) to associate
    -- with the email identity.
    CreateEmailIdentity -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The email address or domain to verify.
    CreateEmailIdentity -> Text
emailIdentity :: Prelude.Text
  }
  deriving (CreateEmailIdentity -> CreateEmailIdentity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEmailIdentity -> CreateEmailIdentity -> Bool
$c/= :: CreateEmailIdentity -> CreateEmailIdentity -> Bool
== :: CreateEmailIdentity -> CreateEmailIdentity -> Bool
$c== :: CreateEmailIdentity -> CreateEmailIdentity -> Bool
Prelude.Eq, Int -> CreateEmailIdentity -> ShowS
[CreateEmailIdentity] -> ShowS
CreateEmailIdentity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEmailIdentity] -> ShowS
$cshowList :: [CreateEmailIdentity] -> ShowS
show :: CreateEmailIdentity -> String
$cshow :: CreateEmailIdentity -> String
showsPrec :: Int -> CreateEmailIdentity -> ShowS
$cshowsPrec :: Int -> CreateEmailIdentity -> ShowS
Prelude.Show, forall x. Rep CreateEmailIdentity x -> CreateEmailIdentity
forall x. CreateEmailIdentity -> Rep CreateEmailIdentity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateEmailIdentity x -> CreateEmailIdentity
$cfrom :: forall x. CreateEmailIdentity -> Rep CreateEmailIdentity x
Prelude.Generic)

-- |
-- Create a value of 'CreateEmailIdentity' 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:
--
-- 'configurationSetName', 'createEmailIdentity_configurationSetName' - The configuration set to use by default when sending from this identity.
-- Note that any configuration set defined in the email sending request
-- takes precedence.
--
-- 'dkimSigningAttributes', 'createEmailIdentity_dkimSigningAttributes' - If your request includes this object, Amazon SES configures the identity
-- to use Bring Your Own DKIM (BYODKIM) for DKIM authentication purposes,
-- or, configures the key length to be used for
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/easy-dkim.html Easy DKIM>.
--
-- You can only specify this object if the email identity is a domain, as
-- opposed to an address.
--
-- 'tags', 'createEmailIdentity_tags' - An array of objects that define the tags (keys and values) to associate
-- with the email identity.
--
-- 'emailIdentity', 'createEmailIdentity_emailIdentity' - The email address or domain to verify.
newCreateEmailIdentity ::
  -- | 'emailIdentity'
  Prelude.Text ->
  CreateEmailIdentity
newCreateEmailIdentity :: Text -> CreateEmailIdentity
newCreateEmailIdentity Text
pEmailIdentity_ =
  CreateEmailIdentity'
    { $sel:configurationSetName:CreateEmailIdentity' :: Maybe Text
configurationSetName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dkimSigningAttributes:CreateEmailIdentity' :: Maybe DkimSigningAttributes
dkimSigningAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateEmailIdentity' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:emailIdentity:CreateEmailIdentity' :: Text
emailIdentity = Text
pEmailIdentity_
    }

-- | The configuration set to use by default when sending from this identity.
-- Note that any configuration set defined in the email sending request
-- takes precedence.
createEmailIdentity_configurationSetName :: Lens.Lens' CreateEmailIdentity (Prelude.Maybe Prelude.Text)
createEmailIdentity_configurationSetName :: Lens' CreateEmailIdentity (Maybe Text)
createEmailIdentity_configurationSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEmailIdentity' {Maybe Text
configurationSetName :: Maybe Text
$sel:configurationSetName:CreateEmailIdentity' :: CreateEmailIdentity -> Maybe Text
configurationSetName} -> Maybe Text
configurationSetName) (\s :: CreateEmailIdentity
s@CreateEmailIdentity' {} Maybe Text
a -> CreateEmailIdentity
s {$sel:configurationSetName:CreateEmailIdentity' :: Maybe Text
configurationSetName = Maybe Text
a} :: CreateEmailIdentity)

-- | If your request includes this object, Amazon SES configures the identity
-- to use Bring Your Own DKIM (BYODKIM) for DKIM authentication purposes,
-- or, configures the key length to be used for
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/easy-dkim.html Easy DKIM>.
--
-- You can only specify this object if the email identity is a domain, as
-- opposed to an address.
createEmailIdentity_dkimSigningAttributes :: Lens.Lens' CreateEmailIdentity (Prelude.Maybe DkimSigningAttributes)
createEmailIdentity_dkimSigningAttributes :: Lens' CreateEmailIdentity (Maybe DkimSigningAttributes)
createEmailIdentity_dkimSigningAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEmailIdentity' {Maybe DkimSigningAttributes
dkimSigningAttributes :: Maybe DkimSigningAttributes
$sel:dkimSigningAttributes:CreateEmailIdentity' :: CreateEmailIdentity -> Maybe DkimSigningAttributes
dkimSigningAttributes} -> Maybe DkimSigningAttributes
dkimSigningAttributes) (\s :: CreateEmailIdentity
s@CreateEmailIdentity' {} Maybe DkimSigningAttributes
a -> CreateEmailIdentity
s {$sel:dkimSigningAttributes:CreateEmailIdentity' :: Maybe DkimSigningAttributes
dkimSigningAttributes = Maybe DkimSigningAttributes
a} :: CreateEmailIdentity)

-- | An array of objects that define the tags (keys and values) to associate
-- with the email identity.
createEmailIdentity_tags :: Lens.Lens' CreateEmailIdentity (Prelude.Maybe [Tag])
createEmailIdentity_tags :: Lens' CreateEmailIdentity (Maybe [Tag])
createEmailIdentity_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEmailIdentity' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateEmailIdentity' :: CreateEmailIdentity -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateEmailIdentity
s@CreateEmailIdentity' {} Maybe [Tag]
a -> CreateEmailIdentity
s {$sel:tags:CreateEmailIdentity' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateEmailIdentity) 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 email address or domain to verify.
createEmailIdentity_emailIdentity :: Lens.Lens' CreateEmailIdentity Prelude.Text
createEmailIdentity_emailIdentity :: Lens' CreateEmailIdentity Text
createEmailIdentity_emailIdentity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEmailIdentity' {Text
emailIdentity :: Text
$sel:emailIdentity:CreateEmailIdentity' :: CreateEmailIdentity -> Text
emailIdentity} -> Text
emailIdentity) (\s :: CreateEmailIdentity
s@CreateEmailIdentity' {} Text
a -> CreateEmailIdentity
s {$sel:emailIdentity:CreateEmailIdentity' :: Text
emailIdentity = Text
a} :: CreateEmailIdentity)

instance Core.AWSRequest CreateEmailIdentity where
  type
    AWSResponse CreateEmailIdentity =
      CreateEmailIdentityResponse
  request :: (Service -> Service)
-> CreateEmailIdentity -> Request CreateEmailIdentity
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 CreateEmailIdentity
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateEmailIdentity)))
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 DkimAttributes
-> Maybe IdentityType
-> Maybe Bool
-> Int
-> CreateEmailIdentityResponse
CreateEmailIdentityResponse'
            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
"DkimAttributes")
            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
"IdentityType")
            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
"VerifiedForSendingStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateEmailIdentity where
  hashWithSalt :: Int -> CreateEmailIdentity -> Int
hashWithSalt Int
_salt CreateEmailIdentity' {Maybe [Tag]
Maybe Text
Maybe DkimSigningAttributes
Text
emailIdentity :: Text
tags :: Maybe [Tag]
dkimSigningAttributes :: Maybe DkimSigningAttributes
configurationSetName :: Maybe Text
$sel:emailIdentity:CreateEmailIdentity' :: CreateEmailIdentity -> Text
$sel:tags:CreateEmailIdentity' :: CreateEmailIdentity -> Maybe [Tag]
$sel:dkimSigningAttributes:CreateEmailIdentity' :: CreateEmailIdentity -> Maybe DkimSigningAttributes
$sel:configurationSetName:CreateEmailIdentity' :: CreateEmailIdentity -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
configurationSetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DkimSigningAttributes
dkimSigningAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
emailIdentity

instance Prelude.NFData CreateEmailIdentity where
  rnf :: CreateEmailIdentity -> ()
rnf CreateEmailIdentity' {Maybe [Tag]
Maybe Text
Maybe DkimSigningAttributes
Text
emailIdentity :: Text
tags :: Maybe [Tag]
dkimSigningAttributes :: Maybe DkimSigningAttributes
configurationSetName :: Maybe Text
$sel:emailIdentity:CreateEmailIdentity' :: CreateEmailIdentity -> Text
$sel:tags:CreateEmailIdentity' :: CreateEmailIdentity -> Maybe [Tag]
$sel:dkimSigningAttributes:CreateEmailIdentity' :: CreateEmailIdentity -> Maybe DkimSigningAttributes
$sel:configurationSetName:CreateEmailIdentity' :: CreateEmailIdentity -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
configurationSetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DkimSigningAttributes
dkimSigningAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
emailIdentity

instance Data.ToHeaders CreateEmailIdentity where
  toHeaders :: CreateEmailIdentity -> 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 CreateEmailIdentity where
  toJSON :: CreateEmailIdentity -> Value
toJSON CreateEmailIdentity' {Maybe [Tag]
Maybe Text
Maybe DkimSigningAttributes
Text
emailIdentity :: Text
tags :: Maybe [Tag]
dkimSigningAttributes :: Maybe DkimSigningAttributes
configurationSetName :: Maybe Text
$sel:emailIdentity:CreateEmailIdentity' :: CreateEmailIdentity -> Text
$sel:tags:CreateEmailIdentity' :: CreateEmailIdentity -> Maybe [Tag]
$sel:dkimSigningAttributes:CreateEmailIdentity' :: CreateEmailIdentity -> Maybe DkimSigningAttributes
$sel:configurationSetName:CreateEmailIdentity' :: CreateEmailIdentity -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ConfigurationSetName" 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
configurationSetName,
            (Key
"DkimSigningAttributes" 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 DkimSigningAttributes
dkimSigningAttributes,
            (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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"EmailIdentity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
emailIdentity)
          ]
      )

instance Data.ToPath CreateEmailIdentity where
  toPath :: CreateEmailIdentity -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v2/email/identities"

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

-- | If the email identity is a domain, this object contains information
-- about the DKIM verification status for the domain.
--
-- If the email identity is an email address, this object is empty.
--
-- /See:/ 'newCreateEmailIdentityResponse' smart constructor.
data CreateEmailIdentityResponse = CreateEmailIdentityResponse'
  { -- | An object that contains information about the DKIM attributes for the
    -- identity.
    CreateEmailIdentityResponse -> Maybe DkimAttributes
dkimAttributes :: Prelude.Maybe DkimAttributes,
    -- | The email identity type. Note: the @MANAGED_DOMAIN@ identity type is not
    -- supported.
    CreateEmailIdentityResponse -> Maybe IdentityType
identityType :: Prelude.Maybe IdentityType,
    -- | Specifies whether or not the identity is verified. You can only send
    -- email from verified email addresses or domains. For more information
    -- about verifying identities, see the
    -- <https://docs.aws.amazon.com/pinpoint/latest/userguide/channels-email-manage-verify.html Amazon Pinpoint User Guide>.
    CreateEmailIdentityResponse -> Maybe Bool
verifiedForSendingStatus :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    CreateEmailIdentityResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateEmailIdentityResponse -> CreateEmailIdentityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEmailIdentityResponse -> CreateEmailIdentityResponse -> Bool
$c/= :: CreateEmailIdentityResponse -> CreateEmailIdentityResponse -> Bool
== :: CreateEmailIdentityResponse -> CreateEmailIdentityResponse -> Bool
$c== :: CreateEmailIdentityResponse -> CreateEmailIdentityResponse -> Bool
Prelude.Eq, ReadPrec [CreateEmailIdentityResponse]
ReadPrec CreateEmailIdentityResponse
Int -> ReadS CreateEmailIdentityResponse
ReadS [CreateEmailIdentityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEmailIdentityResponse]
$creadListPrec :: ReadPrec [CreateEmailIdentityResponse]
readPrec :: ReadPrec CreateEmailIdentityResponse
$creadPrec :: ReadPrec CreateEmailIdentityResponse
readList :: ReadS [CreateEmailIdentityResponse]
$creadList :: ReadS [CreateEmailIdentityResponse]
readsPrec :: Int -> ReadS CreateEmailIdentityResponse
$creadsPrec :: Int -> ReadS CreateEmailIdentityResponse
Prelude.Read, Int -> CreateEmailIdentityResponse -> ShowS
[CreateEmailIdentityResponse] -> ShowS
CreateEmailIdentityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEmailIdentityResponse] -> ShowS
$cshowList :: [CreateEmailIdentityResponse] -> ShowS
show :: CreateEmailIdentityResponse -> String
$cshow :: CreateEmailIdentityResponse -> String
showsPrec :: Int -> CreateEmailIdentityResponse -> ShowS
$cshowsPrec :: Int -> CreateEmailIdentityResponse -> ShowS
Prelude.Show, forall x.
Rep CreateEmailIdentityResponse x -> CreateEmailIdentityResponse
forall x.
CreateEmailIdentityResponse -> Rep CreateEmailIdentityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateEmailIdentityResponse x -> CreateEmailIdentityResponse
$cfrom :: forall x.
CreateEmailIdentityResponse -> Rep CreateEmailIdentityResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateEmailIdentityResponse' 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:
--
-- 'dkimAttributes', 'createEmailIdentityResponse_dkimAttributes' - An object that contains information about the DKIM attributes for the
-- identity.
--
-- 'identityType', 'createEmailIdentityResponse_identityType' - The email identity type. Note: the @MANAGED_DOMAIN@ identity type is not
-- supported.
--
-- 'verifiedForSendingStatus', 'createEmailIdentityResponse_verifiedForSendingStatus' - Specifies whether or not the identity is verified. You can only send
-- email from verified email addresses or domains. For more information
-- about verifying identities, see the
-- <https://docs.aws.amazon.com/pinpoint/latest/userguide/channels-email-manage-verify.html Amazon Pinpoint User Guide>.
--
-- 'httpStatus', 'createEmailIdentityResponse_httpStatus' - The response's http status code.
newCreateEmailIdentityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateEmailIdentityResponse
newCreateEmailIdentityResponse :: Int -> CreateEmailIdentityResponse
newCreateEmailIdentityResponse Int
pHttpStatus_ =
  CreateEmailIdentityResponse'
    { $sel:dkimAttributes:CreateEmailIdentityResponse' :: Maybe DkimAttributes
dkimAttributes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:identityType:CreateEmailIdentityResponse' :: Maybe IdentityType
identityType = forall a. Maybe a
Prelude.Nothing,
      $sel:verifiedForSendingStatus:CreateEmailIdentityResponse' :: Maybe Bool
verifiedForSendingStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateEmailIdentityResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that contains information about the DKIM attributes for the
-- identity.
createEmailIdentityResponse_dkimAttributes :: Lens.Lens' CreateEmailIdentityResponse (Prelude.Maybe DkimAttributes)
createEmailIdentityResponse_dkimAttributes :: Lens' CreateEmailIdentityResponse (Maybe DkimAttributes)
createEmailIdentityResponse_dkimAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEmailIdentityResponse' {Maybe DkimAttributes
dkimAttributes :: Maybe DkimAttributes
$sel:dkimAttributes:CreateEmailIdentityResponse' :: CreateEmailIdentityResponse -> Maybe DkimAttributes
dkimAttributes} -> Maybe DkimAttributes
dkimAttributes) (\s :: CreateEmailIdentityResponse
s@CreateEmailIdentityResponse' {} Maybe DkimAttributes
a -> CreateEmailIdentityResponse
s {$sel:dkimAttributes:CreateEmailIdentityResponse' :: Maybe DkimAttributes
dkimAttributes = Maybe DkimAttributes
a} :: CreateEmailIdentityResponse)

-- | The email identity type. Note: the @MANAGED_DOMAIN@ identity type is not
-- supported.
createEmailIdentityResponse_identityType :: Lens.Lens' CreateEmailIdentityResponse (Prelude.Maybe IdentityType)
createEmailIdentityResponse_identityType :: Lens' CreateEmailIdentityResponse (Maybe IdentityType)
createEmailIdentityResponse_identityType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEmailIdentityResponse' {Maybe IdentityType
identityType :: Maybe IdentityType
$sel:identityType:CreateEmailIdentityResponse' :: CreateEmailIdentityResponse -> Maybe IdentityType
identityType} -> Maybe IdentityType
identityType) (\s :: CreateEmailIdentityResponse
s@CreateEmailIdentityResponse' {} Maybe IdentityType
a -> CreateEmailIdentityResponse
s {$sel:identityType:CreateEmailIdentityResponse' :: Maybe IdentityType
identityType = Maybe IdentityType
a} :: CreateEmailIdentityResponse)

-- | Specifies whether or not the identity is verified. You can only send
-- email from verified email addresses or domains. For more information
-- about verifying identities, see the
-- <https://docs.aws.amazon.com/pinpoint/latest/userguide/channels-email-manage-verify.html Amazon Pinpoint User Guide>.
createEmailIdentityResponse_verifiedForSendingStatus :: Lens.Lens' CreateEmailIdentityResponse (Prelude.Maybe Prelude.Bool)
createEmailIdentityResponse_verifiedForSendingStatus :: Lens' CreateEmailIdentityResponse (Maybe Bool)
createEmailIdentityResponse_verifiedForSendingStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEmailIdentityResponse' {Maybe Bool
verifiedForSendingStatus :: Maybe Bool
$sel:verifiedForSendingStatus:CreateEmailIdentityResponse' :: CreateEmailIdentityResponse -> Maybe Bool
verifiedForSendingStatus} -> Maybe Bool
verifiedForSendingStatus) (\s :: CreateEmailIdentityResponse
s@CreateEmailIdentityResponse' {} Maybe Bool
a -> CreateEmailIdentityResponse
s {$sel:verifiedForSendingStatus:CreateEmailIdentityResponse' :: Maybe Bool
verifiedForSendingStatus = Maybe Bool
a} :: CreateEmailIdentityResponse)

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

instance Prelude.NFData CreateEmailIdentityResponse where
  rnf :: CreateEmailIdentityResponse -> ()
rnf CreateEmailIdentityResponse' {Int
Maybe Bool
Maybe DkimAttributes
Maybe IdentityType
httpStatus :: Int
verifiedForSendingStatus :: Maybe Bool
identityType :: Maybe IdentityType
dkimAttributes :: Maybe DkimAttributes
$sel:httpStatus:CreateEmailIdentityResponse' :: CreateEmailIdentityResponse -> Int
$sel:verifiedForSendingStatus:CreateEmailIdentityResponse' :: CreateEmailIdentityResponse -> Maybe Bool
$sel:identityType:CreateEmailIdentityResponse' :: CreateEmailIdentityResponse -> Maybe IdentityType
$sel:dkimAttributes:CreateEmailIdentityResponse' :: CreateEmailIdentityResponse -> Maybe DkimAttributes
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DkimAttributes
dkimAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IdentityType
identityType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
verifiedForSendingStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus