{-# 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.PutAccountDetails
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update your Amazon SES account details.
module Amazonka.SESV2.PutAccountDetails
  ( -- * Creating a Request
    PutAccountDetails (..),
    newPutAccountDetails,

    -- * Request Lenses
    putAccountDetails_additionalContactEmailAddresses,
    putAccountDetails_contactLanguage,
    putAccountDetails_productionAccessEnabled,
    putAccountDetails_mailType,
    putAccountDetails_websiteURL,
    putAccountDetails_useCaseDescription,

    -- * Destructuring the Response
    PutAccountDetailsResponse (..),
    newPutAccountDetailsResponse,

    -- * Response Lenses
    putAccountDetailsResponse_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 submit new account details.
--
-- /See:/ 'newPutAccountDetails' smart constructor.
data PutAccountDetails = PutAccountDetails'
  { -- | Additional email addresses that you would like to be notified regarding
    -- Amazon SES matters.
    PutAccountDetails -> Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses :: Prelude.Maybe (Data.Sensitive (Prelude.NonEmpty (Data.Sensitive Prelude.Text))),
    -- | The language you would prefer to be contacted with.
    PutAccountDetails -> Maybe ContactLanguage
contactLanguage :: Prelude.Maybe ContactLanguage,
    -- | Indicates whether or not your account should have production access in
    -- the current Amazon Web Services Region.
    --
    -- If the value is @false@, then your account is in the /sandbox/. When
    -- your account is in the sandbox, you can only send email to verified
    -- identities. Additionally, the maximum number of emails you can send in a
    -- 24-hour period (your sending quota) is 200, and the maximum number of
    -- emails you can send per second (your maximum sending rate) is 1.
    --
    -- If the value is @true@, then your account has production access. When
    -- your account has production access, you can send email to any address.
    -- The sending quota and maximum sending rate for your account vary based
    -- on your specific use case.
    PutAccountDetails -> Maybe Bool
productionAccessEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The type of email your account will send.
    PutAccountDetails -> MailType
mailType :: MailType,
    -- | The URL of your website. This information helps us better understand the
    -- type of content that you plan to send.
    PutAccountDetails -> Sensitive Text
websiteURL :: Data.Sensitive Prelude.Text,
    -- | A description of the types of email that you plan to send.
    PutAccountDetails -> Sensitive Text
useCaseDescription :: Data.Sensitive Prelude.Text
  }
  deriving (PutAccountDetails -> PutAccountDetails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutAccountDetails -> PutAccountDetails -> Bool
$c/= :: PutAccountDetails -> PutAccountDetails -> Bool
== :: PutAccountDetails -> PutAccountDetails -> Bool
$c== :: PutAccountDetails -> PutAccountDetails -> Bool
Prelude.Eq, Int -> PutAccountDetails -> ShowS
[PutAccountDetails] -> ShowS
PutAccountDetails -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutAccountDetails] -> ShowS
$cshowList :: [PutAccountDetails] -> ShowS
show :: PutAccountDetails -> String
$cshow :: PutAccountDetails -> String
showsPrec :: Int -> PutAccountDetails -> ShowS
$cshowsPrec :: Int -> PutAccountDetails -> ShowS
Prelude.Show, forall x. Rep PutAccountDetails x -> PutAccountDetails
forall x. PutAccountDetails -> Rep PutAccountDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutAccountDetails x -> PutAccountDetails
$cfrom :: forall x. PutAccountDetails -> Rep PutAccountDetails x
Prelude.Generic)

-- |
-- Create a value of 'PutAccountDetails' 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', 'putAccountDetails_additionalContactEmailAddresses' - Additional email addresses that you would like to be notified regarding
-- Amazon SES matters.
--
-- 'contactLanguage', 'putAccountDetails_contactLanguage' - The language you would prefer to be contacted with.
--
-- 'productionAccessEnabled', 'putAccountDetails_productionAccessEnabled' - Indicates whether or not your account should have production access in
-- the current Amazon Web Services Region.
--
-- If the value is @false@, then your account is in the /sandbox/. When
-- your account is in the sandbox, you can only send email to verified
-- identities. Additionally, the maximum number of emails you can send in a
-- 24-hour period (your sending quota) is 200, and the maximum number of
-- emails you can send per second (your maximum sending rate) is 1.
--
-- If the value is @true@, then your account has production access. When
-- your account has production access, you can send email to any address.
-- The sending quota and maximum sending rate for your account vary based
-- on your specific use case.
--
-- 'mailType', 'putAccountDetails_mailType' - The type of email your account will send.
--
-- 'websiteURL', 'putAccountDetails_websiteURL' - The URL of your website. This information helps us better understand the
-- type of content that you plan to send.
--
-- 'useCaseDescription', 'putAccountDetails_useCaseDescription' - A description of the types of email that you plan to send.
newPutAccountDetails ::
  -- | 'mailType'
  MailType ->
  -- | 'websiteURL'
  Prelude.Text ->
  -- | 'useCaseDescription'
  Prelude.Text ->
  PutAccountDetails
newPutAccountDetails :: MailType -> Text -> Text -> PutAccountDetails
newPutAccountDetails
  MailType
pMailType_
  Text
pWebsiteURL_
  Text
pUseCaseDescription_ =
    PutAccountDetails'
      { $sel:additionalContactEmailAddresses:PutAccountDetails' :: Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses =
          forall a. Maybe a
Prelude.Nothing,
        $sel:contactLanguage:PutAccountDetails' :: Maybe ContactLanguage
contactLanguage = forall a. Maybe a
Prelude.Nothing,
        $sel:productionAccessEnabled:PutAccountDetails' :: Maybe Bool
productionAccessEnabled = forall a. Maybe a
Prelude.Nothing,
        $sel:mailType:PutAccountDetails' :: MailType
mailType = MailType
pMailType_,
        $sel:websiteURL:PutAccountDetails' :: Sensitive Text
websiteURL = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pWebsiteURL_,
        $sel:useCaseDescription:PutAccountDetails' :: Sensitive Text
useCaseDescription =
          forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pUseCaseDescription_
      }

-- | Additional email addresses that you would like to be notified regarding
-- Amazon SES matters.
putAccountDetails_additionalContactEmailAddresses :: Lens.Lens' PutAccountDetails (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
putAccountDetails_additionalContactEmailAddresses :: Lens' PutAccountDetails (Maybe (NonEmpty Text))
putAccountDetails_additionalContactEmailAddresses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAccountDetails' {Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses :: Maybe (Sensitive (NonEmpty (Sensitive Text)))
$sel:additionalContactEmailAddresses:PutAccountDetails' :: PutAccountDetails -> Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses} -> Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses) (\s :: PutAccountDetails
s@PutAccountDetails' {} Maybe (Sensitive (NonEmpty (Sensitive Text)))
a -> PutAccountDetails
s {$sel:additionalContactEmailAddresses:PutAccountDetails' :: Maybe (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses = Maybe (Sensitive (NonEmpty (Sensitive Text)))
a} :: PutAccountDetails) 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 to be contacted with.
putAccountDetails_contactLanguage :: Lens.Lens' PutAccountDetails (Prelude.Maybe ContactLanguage)
putAccountDetails_contactLanguage :: Lens' PutAccountDetails (Maybe ContactLanguage)
putAccountDetails_contactLanguage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAccountDetails' {Maybe ContactLanguage
contactLanguage :: Maybe ContactLanguage
$sel:contactLanguage:PutAccountDetails' :: PutAccountDetails -> Maybe ContactLanguage
contactLanguage} -> Maybe ContactLanguage
contactLanguage) (\s :: PutAccountDetails
s@PutAccountDetails' {} Maybe ContactLanguage
a -> PutAccountDetails
s {$sel:contactLanguage:PutAccountDetails' :: Maybe ContactLanguage
contactLanguage = Maybe ContactLanguage
a} :: PutAccountDetails)

-- | Indicates whether or not your account should have production access in
-- the current Amazon Web Services Region.
--
-- If the value is @false@, then your account is in the /sandbox/. When
-- your account is in the sandbox, you can only send email to verified
-- identities. Additionally, the maximum number of emails you can send in a
-- 24-hour period (your sending quota) is 200, and the maximum number of
-- emails you can send per second (your maximum sending rate) is 1.
--
-- If the value is @true@, then your account has production access. When
-- your account has production access, you can send email to any address.
-- The sending quota and maximum sending rate for your account vary based
-- on your specific use case.
putAccountDetails_productionAccessEnabled :: Lens.Lens' PutAccountDetails (Prelude.Maybe Prelude.Bool)
putAccountDetails_productionAccessEnabled :: Lens' PutAccountDetails (Maybe Bool)
putAccountDetails_productionAccessEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAccountDetails' {Maybe Bool
productionAccessEnabled :: Maybe Bool
$sel:productionAccessEnabled:PutAccountDetails' :: PutAccountDetails -> Maybe Bool
productionAccessEnabled} -> Maybe Bool
productionAccessEnabled) (\s :: PutAccountDetails
s@PutAccountDetails' {} Maybe Bool
a -> PutAccountDetails
s {$sel:productionAccessEnabled:PutAccountDetails' :: Maybe Bool
productionAccessEnabled = Maybe Bool
a} :: PutAccountDetails)

-- | The type of email your account will send.
putAccountDetails_mailType :: Lens.Lens' PutAccountDetails MailType
putAccountDetails_mailType :: Lens' PutAccountDetails MailType
putAccountDetails_mailType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAccountDetails' {MailType
mailType :: MailType
$sel:mailType:PutAccountDetails' :: PutAccountDetails -> MailType
mailType} -> MailType
mailType) (\s :: PutAccountDetails
s@PutAccountDetails' {} MailType
a -> PutAccountDetails
s {$sel:mailType:PutAccountDetails' :: MailType
mailType = MailType
a} :: PutAccountDetails)

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

-- | A description of the types of email that you plan to send.
putAccountDetails_useCaseDescription :: Lens.Lens' PutAccountDetails Prelude.Text
putAccountDetails_useCaseDescription :: Lens' PutAccountDetails Text
putAccountDetails_useCaseDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAccountDetails' {Sensitive Text
useCaseDescription :: Sensitive Text
$sel:useCaseDescription:PutAccountDetails' :: PutAccountDetails -> Sensitive Text
useCaseDescription} -> Sensitive Text
useCaseDescription) (\s :: PutAccountDetails
s@PutAccountDetails' {} Sensitive Text
a -> PutAccountDetails
s {$sel:useCaseDescription:PutAccountDetails' :: Sensitive Text
useCaseDescription = Sensitive Text
a} :: PutAccountDetails) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest PutAccountDetails where
  type
    AWSResponse PutAccountDetails =
      PutAccountDetailsResponse
  request :: (Service -> Service)
-> PutAccountDetails -> Request PutAccountDetails
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 PutAccountDetails
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutAccountDetails)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> PutAccountDetailsResponse
PutAccountDetailsResponse'
            forall (f :: * -> *) a b. Functor 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 PutAccountDetails where
  hashWithSalt :: Int -> PutAccountDetails -> Int
hashWithSalt Int
_salt PutAccountDetails' {Maybe Bool
Maybe (Sensitive (NonEmpty (Sensitive Text)))
Maybe ContactLanguage
Sensitive Text
MailType
useCaseDescription :: Sensitive Text
websiteURL :: Sensitive Text
mailType :: MailType
productionAccessEnabled :: Maybe Bool
contactLanguage :: Maybe ContactLanguage
additionalContactEmailAddresses :: Maybe (Sensitive (NonEmpty (Sensitive Text)))
$sel:useCaseDescription:PutAccountDetails' :: PutAccountDetails -> Sensitive Text
$sel:websiteURL:PutAccountDetails' :: PutAccountDetails -> Sensitive Text
$sel:mailType:PutAccountDetails' :: PutAccountDetails -> MailType
$sel:productionAccessEnabled:PutAccountDetails' :: PutAccountDetails -> Maybe Bool
$sel:contactLanguage:PutAccountDetails' :: PutAccountDetails -> Maybe ContactLanguage
$sel:additionalContactEmailAddresses:PutAccountDetails' :: PutAccountDetails -> 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 Bool
productionAccessEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MailType
mailType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
websiteURL
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
useCaseDescription

instance Prelude.NFData PutAccountDetails where
  rnf :: PutAccountDetails -> ()
rnf PutAccountDetails' {Maybe Bool
Maybe (Sensitive (NonEmpty (Sensitive Text)))
Maybe ContactLanguage
Sensitive Text
MailType
useCaseDescription :: Sensitive Text
websiteURL :: Sensitive Text
mailType :: MailType
productionAccessEnabled :: Maybe Bool
contactLanguage :: Maybe ContactLanguage
additionalContactEmailAddresses :: Maybe (Sensitive (NonEmpty (Sensitive Text)))
$sel:useCaseDescription:PutAccountDetails' :: PutAccountDetails -> Sensitive Text
$sel:websiteURL:PutAccountDetails' :: PutAccountDetails -> Sensitive Text
$sel:mailType:PutAccountDetails' :: PutAccountDetails -> MailType
$sel:productionAccessEnabled:PutAccountDetails' :: PutAccountDetails -> Maybe Bool
$sel:contactLanguage:PutAccountDetails' :: PutAccountDetails -> Maybe ContactLanguage
$sel:additionalContactEmailAddresses:PutAccountDetails' :: PutAccountDetails -> 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 Bool
productionAccessEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MailType
mailType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
websiteURL
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
useCaseDescription

instance Data.ToHeaders PutAccountDetails where
  toHeaders :: PutAccountDetails -> 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 PutAccountDetails where
  toJSON :: PutAccountDetails -> Value
toJSON PutAccountDetails' {Maybe Bool
Maybe (Sensitive (NonEmpty (Sensitive Text)))
Maybe ContactLanguage
Sensitive Text
MailType
useCaseDescription :: Sensitive Text
websiteURL :: Sensitive Text
mailType :: MailType
productionAccessEnabled :: Maybe Bool
contactLanguage :: Maybe ContactLanguage
additionalContactEmailAddresses :: Maybe (Sensitive (NonEmpty (Sensitive Text)))
$sel:useCaseDescription:PutAccountDetails' :: PutAccountDetails -> Sensitive Text
$sel:websiteURL:PutAccountDetails' :: PutAccountDetails -> Sensitive Text
$sel:mailType:PutAccountDetails' :: PutAccountDetails -> MailType
$sel:productionAccessEnabled:PutAccountDetails' :: PutAccountDetails -> Maybe Bool
$sel:contactLanguage:PutAccountDetails' :: PutAccountDetails -> Maybe ContactLanguage
$sel:additionalContactEmailAddresses:PutAccountDetails' :: PutAccountDetails -> Maybe (Sensitive (NonEmpty (Sensitive Text)))
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AdditionalContactEmailAddresses" 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 (Sensitive (NonEmpty (Sensitive Text)))
additionalContactEmailAddresses,
            (Key
"ContactLanguage" 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 ContactLanguage
contactLanguage,
            (Key
"ProductionAccessEnabled" 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 Bool
productionAccessEnabled,
            forall a. a -> Maybe a
Prelude.Just (Key
"MailType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MailType
mailType),
            forall a. a -> Maybe a
Prelude.Just (Key
"WebsiteURL" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
websiteURL),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"UseCaseDescription" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
useCaseDescription)
          ]
      )

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

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

-- | An HTTP 200 response if the request succeeds, or an error message if the
-- request fails.
--
-- /See:/ 'newPutAccountDetailsResponse' smart constructor.
data PutAccountDetailsResponse = PutAccountDetailsResponse'
  { -- | The response's http status code.
    PutAccountDetailsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutAccountDetailsResponse -> PutAccountDetailsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutAccountDetailsResponse -> PutAccountDetailsResponse -> Bool
$c/= :: PutAccountDetailsResponse -> PutAccountDetailsResponse -> Bool
== :: PutAccountDetailsResponse -> PutAccountDetailsResponse -> Bool
$c== :: PutAccountDetailsResponse -> PutAccountDetailsResponse -> Bool
Prelude.Eq, ReadPrec [PutAccountDetailsResponse]
ReadPrec PutAccountDetailsResponse
Int -> ReadS PutAccountDetailsResponse
ReadS [PutAccountDetailsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutAccountDetailsResponse]
$creadListPrec :: ReadPrec [PutAccountDetailsResponse]
readPrec :: ReadPrec PutAccountDetailsResponse
$creadPrec :: ReadPrec PutAccountDetailsResponse
readList :: ReadS [PutAccountDetailsResponse]
$creadList :: ReadS [PutAccountDetailsResponse]
readsPrec :: Int -> ReadS PutAccountDetailsResponse
$creadsPrec :: Int -> ReadS PutAccountDetailsResponse
Prelude.Read, Int -> PutAccountDetailsResponse -> ShowS
[PutAccountDetailsResponse] -> ShowS
PutAccountDetailsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutAccountDetailsResponse] -> ShowS
$cshowList :: [PutAccountDetailsResponse] -> ShowS
show :: PutAccountDetailsResponse -> String
$cshow :: PutAccountDetailsResponse -> String
showsPrec :: Int -> PutAccountDetailsResponse -> ShowS
$cshowsPrec :: Int -> PutAccountDetailsResponse -> ShowS
Prelude.Show, forall x.
Rep PutAccountDetailsResponse x -> PutAccountDetailsResponse
forall x.
PutAccountDetailsResponse -> Rep PutAccountDetailsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutAccountDetailsResponse x -> PutAccountDetailsResponse
$cfrom :: forall x.
PutAccountDetailsResponse -> Rep PutAccountDetailsResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutAccountDetailsResponse' 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:
--
-- 'httpStatus', 'putAccountDetailsResponse_httpStatus' - The response's http status code.
newPutAccountDetailsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutAccountDetailsResponse
newPutAccountDetailsResponse :: Int -> PutAccountDetailsResponse
newPutAccountDetailsResponse Int
pHttpStatus_ =
  PutAccountDetailsResponse'
    { $sel:httpStatus:PutAccountDetailsResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData PutAccountDetailsResponse where
  rnf :: PutAccountDetailsResponse -> ()
rnf PutAccountDetailsResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutAccountDetailsResponse' :: PutAccountDetailsResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus