{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.AccountDetails
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.SESV2.Types.AccountDetails 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 Amazonka.SESV2.Types.ContactLanguage
import Amazonka.SESV2.Types.MailType
import Amazonka.SESV2.Types.ReviewDetails

-- | An object that contains information about your account details.
--
-- /See:/ 'newAccountDetails' smart constructor.
data AccountDetails = AccountDetails'
  { -- | Additional email addresses where updates are sent about your account
    -- review process.
    AccountDetails -> Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses :: Prelude.Maybe (Data.Sensitive (Prelude.NonEmpty (Data.Sensitive Prelude.Text))),
    -- | The language you would prefer for the case. The contact language can be
    -- one of @ENGLISH@ or @JAPANESE@.
    AccountDetails -> Maybe ContactLanguage
contactLanguage :: Prelude.Maybe ContactLanguage,
    -- | The type of email your account is sending. The mail type can be one of
    -- the following:
    --
    -- -   @MARKETING@ – Most of your sending traffic is to keep your customers
    --     informed of your latest offering.
    --
    -- -   @TRANSACTIONAL@ – Most of your sending traffic is to communicate
    --     during a transaction with a customer.
    AccountDetails -> Maybe MailType
mailType :: Prelude.Maybe MailType,
    -- | Information about the review of the latest details you submitted.
    AccountDetails -> Maybe ReviewDetails
reviewDetails :: Prelude.Maybe ReviewDetails,
    -- | A description of the types of email that you plan to send.
    AccountDetails -> Maybe (Sensitive Text)
useCaseDescription :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The URL of your website. This information helps us better understand the
    -- type of content that you plan to send.
    AccountDetails -> Maybe (Sensitive Text)
websiteURL :: Prelude.Maybe (Data.Sensitive Prelude.Text)
  }
  deriving (AccountDetails -> AccountDetails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountDetails -> AccountDetails -> Bool
$c/= :: AccountDetails -> AccountDetails -> Bool
== :: AccountDetails -> AccountDetails -> Bool
$c== :: AccountDetails -> AccountDetails -> Bool
Prelude.Eq, Int -> AccountDetails -> ShowS
[AccountDetails] -> ShowS
AccountDetails -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountDetails] -> ShowS
$cshowList :: [AccountDetails] -> ShowS
show :: AccountDetails -> String
$cshow :: AccountDetails -> String
showsPrec :: Int -> AccountDetails -> ShowS
$cshowsPrec :: Int -> AccountDetails -> ShowS
Prelude.Show, forall x. Rep AccountDetails x -> AccountDetails
forall x. AccountDetails -> Rep AccountDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccountDetails x -> AccountDetails
$cfrom :: forall x. AccountDetails -> Rep AccountDetails x
Prelude.Generic)

-- |
-- Create a value of 'AccountDetails' 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:
--
-- 'additionalContactEmailAddresses', 'accountDetails_additionalContactEmailAddresses' - Additional email addresses where updates are sent about your account
-- review process.
--
-- 'contactLanguage', 'accountDetails_contactLanguage' - The language you would prefer for the case. The contact language can be
-- one of @ENGLISH@ or @JAPANESE@.
--
-- 'mailType', 'accountDetails_mailType' - The type of email your account is sending. The mail type can be one of
-- the following:
--
-- -   @MARKETING@ – Most of your sending traffic is to keep your customers
--     informed of your latest offering.
--
-- -   @TRANSACTIONAL@ – Most of your sending traffic is to communicate
--     during a transaction with a customer.
--
-- 'reviewDetails', 'accountDetails_reviewDetails' - Information about the review of the latest details you submitted.
--
-- 'useCaseDescription', 'accountDetails_useCaseDescription' - A description of the types of email that you plan to send.
--
-- 'websiteURL', 'accountDetails_websiteURL' - The URL of your website. This information helps us better understand the
-- type of content that you plan to send.
newAccountDetails ::
  AccountDetails
newAccountDetails :: AccountDetails
newAccountDetails =
  AccountDetails'
    { $sel:additionalContactEmailAddresses:AccountDetails' :: Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses =
        forall a. Maybe a
Prelude.Nothing,
      $sel:contactLanguage:AccountDetails' :: Maybe ContactLanguage
contactLanguage = forall a. Maybe a
Prelude.Nothing,
      $sel:mailType:AccountDetails' :: Maybe MailType
mailType = forall a. Maybe a
Prelude.Nothing,
      $sel:reviewDetails:AccountDetails' :: Maybe ReviewDetails
reviewDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:useCaseDescription:AccountDetails' :: Maybe (Sensitive Text)
useCaseDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:websiteURL:AccountDetails' :: Maybe (Sensitive Text)
websiteURL = forall a. Maybe a
Prelude.Nothing
    }

-- | Additional email addresses where updates are sent about your account
-- review process.
accountDetails_additionalContactEmailAddresses :: Lens.Lens' AccountDetails (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
accountDetails_additionalContactEmailAddresses :: Lens' AccountDetails (Maybe (NonEmpty Text))
accountDetails_additionalContactEmailAddresses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccountDetails' {Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses :: Maybe (Sensitive (NonEmpty (Sensitive Text)))
$sel:additionalContactEmailAddresses:AccountDetails' :: AccountDetails -> Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses} -> Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses) (\s :: AccountDetails
s@AccountDetails' {} Maybe (Sensitive (NonEmpty (Sensitive Text)))
a -> AccountDetails
s {$sel:additionalContactEmailAddresses:AccountDetails' :: Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses = Maybe (Sensitive (NonEmpty (Sensitive Text)))
a} :: AccountDetails) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | The language you would prefer for the case. The contact language can be
-- one of @ENGLISH@ or @JAPANESE@.
accountDetails_contactLanguage :: Lens.Lens' AccountDetails (Prelude.Maybe ContactLanguage)
accountDetails_contactLanguage :: Lens' AccountDetails (Maybe ContactLanguage)
accountDetails_contactLanguage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccountDetails' {Maybe ContactLanguage
contactLanguage :: Maybe ContactLanguage
$sel:contactLanguage:AccountDetails' :: AccountDetails -> Maybe ContactLanguage
contactLanguage} -> Maybe ContactLanguage
contactLanguage) (\s :: AccountDetails
s@AccountDetails' {} Maybe ContactLanguage
a -> AccountDetails
s {$sel:contactLanguage:AccountDetails' :: Maybe ContactLanguage
contactLanguage = Maybe ContactLanguage
a} :: AccountDetails)

-- | The type of email your account is sending. The mail type can be one of
-- the following:
--
-- -   @MARKETING@ – Most of your sending traffic is to keep your customers
--     informed of your latest offering.
--
-- -   @TRANSACTIONAL@ – Most of your sending traffic is to communicate
--     during a transaction with a customer.
accountDetails_mailType :: Lens.Lens' AccountDetails (Prelude.Maybe MailType)
accountDetails_mailType :: Lens' AccountDetails (Maybe MailType)
accountDetails_mailType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccountDetails' {Maybe MailType
mailType :: Maybe MailType
$sel:mailType:AccountDetails' :: AccountDetails -> Maybe MailType
mailType} -> Maybe MailType
mailType) (\s :: AccountDetails
s@AccountDetails' {} Maybe MailType
a -> AccountDetails
s {$sel:mailType:AccountDetails' :: Maybe MailType
mailType = Maybe MailType
a} :: AccountDetails)

-- | Information about the review of the latest details you submitted.
accountDetails_reviewDetails :: Lens.Lens' AccountDetails (Prelude.Maybe ReviewDetails)
accountDetails_reviewDetails :: Lens' AccountDetails (Maybe ReviewDetails)
accountDetails_reviewDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccountDetails' {Maybe ReviewDetails
reviewDetails :: Maybe ReviewDetails
$sel:reviewDetails:AccountDetails' :: AccountDetails -> Maybe ReviewDetails
reviewDetails} -> Maybe ReviewDetails
reviewDetails) (\s :: AccountDetails
s@AccountDetails' {} Maybe ReviewDetails
a -> AccountDetails
s {$sel:reviewDetails:AccountDetails' :: Maybe ReviewDetails
reviewDetails = Maybe ReviewDetails
a} :: AccountDetails)

-- | A description of the types of email that you plan to send.
accountDetails_useCaseDescription :: Lens.Lens' AccountDetails (Prelude.Maybe Prelude.Text)
accountDetails_useCaseDescription :: Lens' AccountDetails (Maybe Text)
accountDetails_useCaseDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccountDetails' {Maybe (Sensitive Text)
useCaseDescription :: Maybe (Sensitive Text)
$sel:useCaseDescription:AccountDetails' :: AccountDetails -> Maybe (Sensitive Text)
useCaseDescription} -> Maybe (Sensitive Text)
useCaseDescription) (\s :: AccountDetails
s@AccountDetails' {} Maybe (Sensitive Text)
a -> AccountDetails
s {$sel:useCaseDescription:AccountDetails' :: Maybe (Sensitive Text)
useCaseDescription = Maybe (Sensitive Text)
a} :: AccountDetails) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The URL of your website. This information helps us better understand the
-- type of content that you plan to send.
accountDetails_websiteURL :: Lens.Lens' AccountDetails (Prelude.Maybe Prelude.Text)
accountDetails_websiteURL :: Lens' AccountDetails (Maybe Text)
accountDetails_websiteURL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccountDetails' {Maybe (Sensitive Text)
websiteURL :: Maybe (Sensitive Text)
$sel:websiteURL:AccountDetails' :: AccountDetails -> Maybe (Sensitive Text)
websiteURL} -> Maybe (Sensitive Text)
websiteURL) (\s :: AccountDetails
s@AccountDetails' {} Maybe (Sensitive Text)
a -> AccountDetails
s {$sel:websiteURL:AccountDetails' :: Maybe (Sensitive Text)
websiteURL = Maybe (Sensitive Text)
a} :: AccountDetails) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Data.FromJSON AccountDetails where
  parseJSON :: Value -> Parser AccountDetails
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"AccountDetails"
      ( \Object
x ->
          Maybe (Sensitive (NonEmpty (Sensitive Text)))
-> Maybe ContactLanguage
-> Maybe MailType
-> Maybe ReviewDetails
-> Maybe (Sensitive Text)
-> Maybe (Sensitive Text)
-> AccountDetails
AccountDetails'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AdditionalContactEmailAddresses")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ContactLanguage")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"MailType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ReviewDetails")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"UseCaseDescription")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"WebsiteURL")
      )

instance Prelude.Hashable AccountDetails where
  hashWithSalt :: Int -> AccountDetails -> Int
hashWithSalt Int
_salt AccountDetails' {Maybe (Sensitive (NonEmpty (Sensitive Text)))
Maybe (Sensitive Text)
Maybe ContactLanguage
Maybe MailType
Maybe ReviewDetails
websiteURL :: Maybe (Sensitive Text)
useCaseDescription :: Maybe (Sensitive Text)
reviewDetails :: Maybe ReviewDetails
mailType :: Maybe MailType
contactLanguage :: Maybe ContactLanguage
additionalContactEmailAddresses :: Maybe (Sensitive (NonEmpty (Sensitive Text)))
$sel:websiteURL:AccountDetails' :: AccountDetails -> Maybe (Sensitive Text)
$sel:useCaseDescription:AccountDetails' :: AccountDetails -> Maybe (Sensitive Text)
$sel:reviewDetails:AccountDetails' :: AccountDetails -> Maybe ReviewDetails
$sel:mailType:AccountDetails' :: AccountDetails -> Maybe MailType
$sel:contactLanguage:AccountDetails' :: AccountDetails -> Maybe ContactLanguage
$sel:additionalContactEmailAddresses:AccountDetails' :: AccountDetails -> Maybe (Sensitive (NonEmpty (Sensitive Text)))
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContactLanguage
contactLanguage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MailType
mailType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReviewDetails
reviewDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
useCaseDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
websiteURL

instance Prelude.NFData AccountDetails where
  rnf :: AccountDetails -> ()
rnf AccountDetails' {Maybe (Sensitive (NonEmpty (Sensitive Text)))
Maybe (Sensitive Text)
Maybe ContactLanguage
Maybe MailType
Maybe ReviewDetails
websiteURL :: Maybe (Sensitive Text)
useCaseDescription :: Maybe (Sensitive Text)
reviewDetails :: Maybe ReviewDetails
mailType :: Maybe MailType
contactLanguage :: Maybe ContactLanguage
additionalContactEmailAddresses :: Maybe (Sensitive (NonEmpty (Sensitive Text)))
$sel:websiteURL:AccountDetails' :: AccountDetails -> Maybe (Sensitive Text)
$sel:useCaseDescription:AccountDetails' :: AccountDetails -> Maybe (Sensitive Text)
$sel:reviewDetails:AccountDetails' :: AccountDetails -> Maybe ReviewDetails
$sel:mailType:AccountDetails' :: AccountDetails -> Maybe MailType
$sel:contactLanguage:AccountDetails' :: AccountDetails -> Maybe ContactLanguage
$sel:additionalContactEmailAddresses:AccountDetails' :: AccountDetails -> Maybe (Sensitive (NonEmpty (Sensitive Text)))
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ContactLanguage
contactLanguage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MailType
mailType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ReviewDetails
reviewDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
useCaseDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
websiteURL