{-# 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.Organizations.Types.CreateAccountStatus
-- 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.Organizations.Types.CreateAccountStatus where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Organizations.Types.CreateAccountFailureReason
import Amazonka.Organizations.Types.CreateAccountState
import qualified Amazonka.Prelude as Prelude

-- | Contains the status about a CreateAccount or CreateGovCloudAccount
-- request to create an Amazon Web Services account or an Amazon Web
-- Services GovCloud (US) account in an organization.
--
-- /See:/ 'newCreateAccountStatus' smart constructor.
data CreateAccountStatus = CreateAccountStatus'
  { -- | If the account was created successfully, the unique identifier (ID) of
    -- the new account.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> for an account ID
    -- string requires exactly 12 digits.
    CreateAccountStatus -> Maybe Text
accountId :: Prelude.Maybe Prelude.Text,
    -- | The account name given to the account when it was created.
    CreateAccountStatus -> Maybe (Sensitive Text)
accountName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The date and time that the account was created and the request
    -- completed.
    CreateAccountStatus -> Maybe POSIX
completedTimestamp :: Prelude.Maybe Data.POSIX,
    -- | If the request failed, a description of the reason for the failure.
    --
    -- -   ACCOUNT_LIMIT_EXCEEDED: The account couldn\'t be created because you
    --     reached the limit on the number of accounts in your organization.
    --
    -- -   CONCURRENT_ACCOUNT_MODIFICATION: You already submitted a request
    --     with the same information.
    --
    -- -   EMAIL_ALREADY_EXISTS: The account could not be created because
    --     another Amazon Web Services account with that email address already
    --     exists.
    --
    -- -   FAILED_BUSINESS_VALIDATION: The Amazon Web Services account that
    --     owns your organization failed to receive business license
    --     validation.
    --
    -- -   GOVCLOUD_ACCOUNT_ALREADY_EXISTS: The account in the Amazon Web
    --     Services GovCloud (US) Region could not be created because this
    --     Region already includes an account with that email address.
    --
    -- -   IDENTITY_INVALID_BUSINESS_VALIDATION: The Amazon Web Services
    --     account that owns your organization can\'t complete business license
    --     validation because it doesn\'t have valid identity data.
    --
    -- -   INVALID_ADDRESS: The account could not be created because the
    --     address you provided is not valid.
    --
    -- -   INVALID_EMAIL: The account could not be created because the email
    --     address you provided is not valid.
    --
    -- -   INVALID_PAYMENT_INSTRUMENT: The Amazon Web Services account that
    --     owns your organization does not have a supported payment method
    --     associated with the account. Amazon Web Services does not support
    --     cards issued by financial institutions in Russia or Belarus. For
    --     more information, see
    --     <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/manage-general.html Managing your Amazon Web Services payments>.
    --
    -- -   INTERNAL_FAILURE: The account could not be created because of an
    --     internal failure. Try again later. If the problem persists, contact
    --     Amazon Web Services Customer Support.
    --
    -- -   MISSING_BUSINESS_VALIDATION: The Amazon Web Services account that
    --     owns your organization has not received Business Validation.
    --
    -- -   MISSING_PAYMENT_INSTRUMENT: You must configure the management
    --     account with a valid payment method, such as a credit card.
    --
    -- -   PENDING_BUSINESS_VALIDATION: The Amazon Web Services account that
    --     owns your organization is still in the process of completing
    --     business license validation.
    --
    -- -   UNKNOWN_BUSINESS_VALIDATION: The Amazon Web Services account that
    --     owns your organization has an unknown issue with business license
    --     validation.
    CreateAccountStatus -> Maybe CreateAccountFailureReason
failureReason :: Prelude.Maybe CreateAccountFailureReason,
    -- | If the account was created successfully, the unique identifier (ID) of
    -- the new account in the Amazon Web Services GovCloud (US) Region.
    CreateAccountStatus -> Maybe Text
govCloudAccountId :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier (ID) that references this request. You get this
    -- value from the response of the initial CreateAccount request to create
    -- the account.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> for a create account
    -- request ID string requires \"car-\" followed by from 8 to 32 lowercase
    -- letters or digits.
    CreateAccountStatus -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The date and time that the request was made for the account creation.
    CreateAccountStatus -> Maybe POSIX
requestedTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The status of the asynchronous request to create an Amazon Web Services
    -- account.
    CreateAccountStatus -> Maybe CreateAccountState
state :: Prelude.Maybe CreateAccountState
  }
  deriving (CreateAccountStatus -> CreateAccountStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAccountStatus -> CreateAccountStatus -> Bool
$c/= :: CreateAccountStatus -> CreateAccountStatus -> Bool
== :: CreateAccountStatus -> CreateAccountStatus -> Bool
$c== :: CreateAccountStatus -> CreateAccountStatus -> Bool
Prelude.Eq, Int -> CreateAccountStatus -> ShowS
[CreateAccountStatus] -> ShowS
CreateAccountStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAccountStatus] -> ShowS
$cshowList :: [CreateAccountStatus] -> ShowS
show :: CreateAccountStatus -> String
$cshow :: CreateAccountStatus -> String
showsPrec :: Int -> CreateAccountStatus -> ShowS
$cshowsPrec :: Int -> CreateAccountStatus -> ShowS
Prelude.Show, forall x. Rep CreateAccountStatus x -> CreateAccountStatus
forall x. CreateAccountStatus -> Rep CreateAccountStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAccountStatus x -> CreateAccountStatus
$cfrom :: forall x. CreateAccountStatus -> Rep CreateAccountStatus x
Prelude.Generic)

-- |
-- Create a value of 'CreateAccountStatus' 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:
--
-- 'accountId', 'createAccountStatus_accountId' - If the account was created successfully, the unique identifier (ID) of
-- the new account.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for an account ID
-- string requires exactly 12 digits.
--
-- 'accountName', 'createAccountStatus_accountName' - The account name given to the account when it was created.
--
-- 'completedTimestamp', 'createAccountStatus_completedTimestamp' - The date and time that the account was created and the request
-- completed.
--
-- 'failureReason', 'createAccountStatus_failureReason' - If the request failed, a description of the reason for the failure.
--
-- -   ACCOUNT_LIMIT_EXCEEDED: The account couldn\'t be created because you
--     reached the limit on the number of accounts in your organization.
--
-- -   CONCURRENT_ACCOUNT_MODIFICATION: You already submitted a request
--     with the same information.
--
-- -   EMAIL_ALREADY_EXISTS: The account could not be created because
--     another Amazon Web Services account with that email address already
--     exists.
--
-- -   FAILED_BUSINESS_VALIDATION: The Amazon Web Services account that
--     owns your organization failed to receive business license
--     validation.
--
-- -   GOVCLOUD_ACCOUNT_ALREADY_EXISTS: The account in the Amazon Web
--     Services GovCloud (US) Region could not be created because this
--     Region already includes an account with that email address.
--
-- -   IDENTITY_INVALID_BUSINESS_VALIDATION: The Amazon Web Services
--     account that owns your organization can\'t complete business license
--     validation because it doesn\'t have valid identity data.
--
-- -   INVALID_ADDRESS: The account could not be created because the
--     address you provided is not valid.
--
-- -   INVALID_EMAIL: The account could not be created because the email
--     address you provided is not valid.
--
-- -   INVALID_PAYMENT_INSTRUMENT: The Amazon Web Services account that
--     owns your organization does not have a supported payment method
--     associated with the account. Amazon Web Services does not support
--     cards issued by financial institutions in Russia or Belarus. For
--     more information, see
--     <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/manage-general.html Managing your Amazon Web Services payments>.
--
-- -   INTERNAL_FAILURE: The account could not be created because of an
--     internal failure. Try again later. If the problem persists, contact
--     Amazon Web Services Customer Support.
--
-- -   MISSING_BUSINESS_VALIDATION: The Amazon Web Services account that
--     owns your organization has not received Business Validation.
--
-- -   MISSING_PAYMENT_INSTRUMENT: You must configure the management
--     account with a valid payment method, such as a credit card.
--
-- -   PENDING_BUSINESS_VALIDATION: The Amazon Web Services account that
--     owns your organization is still in the process of completing
--     business license validation.
--
-- -   UNKNOWN_BUSINESS_VALIDATION: The Amazon Web Services account that
--     owns your organization has an unknown issue with business license
--     validation.
--
-- 'govCloudAccountId', 'createAccountStatus_govCloudAccountId' - If the account was created successfully, the unique identifier (ID) of
-- the new account in the Amazon Web Services GovCloud (US) Region.
--
-- 'id', 'createAccountStatus_id' - The unique identifier (ID) that references this request. You get this
-- value from the response of the initial CreateAccount request to create
-- the account.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for a create account
-- request ID string requires \"car-\" followed by from 8 to 32 lowercase
-- letters or digits.
--
-- 'requestedTimestamp', 'createAccountStatus_requestedTimestamp' - The date and time that the request was made for the account creation.
--
-- 'state', 'createAccountStatus_state' - The status of the asynchronous request to create an Amazon Web Services
-- account.
newCreateAccountStatus ::
  CreateAccountStatus
newCreateAccountStatus :: CreateAccountStatus
newCreateAccountStatus =
  CreateAccountStatus'
    { $sel:accountId:CreateAccountStatus' :: Maybe Text
accountId = forall a. Maybe a
Prelude.Nothing,
      $sel:accountName:CreateAccountStatus' :: Maybe (Sensitive Text)
accountName = forall a. Maybe a
Prelude.Nothing,
      $sel:completedTimestamp:CreateAccountStatus' :: Maybe POSIX
completedTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:failureReason:CreateAccountStatus' :: Maybe CreateAccountFailureReason
failureReason = forall a. Maybe a
Prelude.Nothing,
      $sel:govCloudAccountId:CreateAccountStatus' :: Maybe Text
govCloudAccountId = forall a. Maybe a
Prelude.Nothing,
      $sel:id:CreateAccountStatus' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:requestedTimestamp:CreateAccountStatus' :: Maybe POSIX
requestedTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:state:CreateAccountStatus' :: Maybe CreateAccountState
state = forall a. Maybe a
Prelude.Nothing
    }

-- | If the account was created successfully, the unique identifier (ID) of
-- the new account.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for an account ID
-- string requires exactly 12 digits.
createAccountStatus_accountId :: Lens.Lens' CreateAccountStatus (Prelude.Maybe Prelude.Text)
createAccountStatus_accountId :: Lens' CreateAccountStatus (Maybe Text)
createAccountStatus_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccountStatus' {Maybe Text
accountId :: Maybe Text
$sel:accountId:CreateAccountStatus' :: CreateAccountStatus -> Maybe Text
accountId} -> Maybe Text
accountId) (\s :: CreateAccountStatus
s@CreateAccountStatus' {} Maybe Text
a -> CreateAccountStatus
s {$sel:accountId:CreateAccountStatus' :: Maybe Text
accountId = Maybe Text
a} :: CreateAccountStatus)

-- | The account name given to the account when it was created.
createAccountStatus_accountName :: Lens.Lens' CreateAccountStatus (Prelude.Maybe Prelude.Text)
createAccountStatus_accountName :: Lens' CreateAccountStatus (Maybe Text)
createAccountStatus_accountName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccountStatus' {Maybe (Sensitive Text)
accountName :: Maybe (Sensitive Text)
$sel:accountName:CreateAccountStatus' :: CreateAccountStatus -> Maybe (Sensitive Text)
accountName} -> Maybe (Sensitive Text)
accountName) (\s :: CreateAccountStatus
s@CreateAccountStatus' {} Maybe (Sensitive Text)
a -> CreateAccountStatus
s {$sel:accountName:CreateAccountStatus' :: Maybe (Sensitive Text)
accountName = Maybe (Sensitive Text)
a} :: CreateAccountStatus) 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 date and time that the account was created and the request
-- completed.
createAccountStatus_completedTimestamp :: Lens.Lens' CreateAccountStatus (Prelude.Maybe Prelude.UTCTime)
createAccountStatus_completedTimestamp :: Lens' CreateAccountStatus (Maybe UTCTime)
createAccountStatus_completedTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccountStatus' {Maybe POSIX
completedTimestamp :: Maybe POSIX
$sel:completedTimestamp:CreateAccountStatus' :: CreateAccountStatus -> Maybe POSIX
completedTimestamp} -> Maybe POSIX
completedTimestamp) (\s :: CreateAccountStatus
s@CreateAccountStatus' {} Maybe POSIX
a -> CreateAccountStatus
s {$sel:completedTimestamp:CreateAccountStatus' :: Maybe POSIX
completedTimestamp = Maybe POSIX
a} :: CreateAccountStatus) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | If the request failed, a description of the reason for the failure.
--
-- -   ACCOUNT_LIMIT_EXCEEDED: The account couldn\'t be created because you
--     reached the limit on the number of accounts in your organization.
--
-- -   CONCURRENT_ACCOUNT_MODIFICATION: You already submitted a request
--     with the same information.
--
-- -   EMAIL_ALREADY_EXISTS: The account could not be created because
--     another Amazon Web Services account with that email address already
--     exists.
--
-- -   FAILED_BUSINESS_VALIDATION: The Amazon Web Services account that
--     owns your organization failed to receive business license
--     validation.
--
-- -   GOVCLOUD_ACCOUNT_ALREADY_EXISTS: The account in the Amazon Web
--     Services GovCloud (US) Region could not be created because this
--     Region already includes an account with that email address.
--
-- -   IDENTITY_INVALID_BUSINESS_VALIDATION: The Amazon Web Services
--     account that owns your organization can\'t complete business license
--     validation because it doesn\'t have valid identity data.
--
-- -   INVALID_ADDRESS: The account could not be created because the
--     address you provided is not valid.
--
-- -   INVALID_EMAIL: The account could not be created because the email
--     address you provided is not valid.
--
-- -   INVALID_PAYMENT_INSTRUMENT: The Amazon Web Services account that
--     owns your organization does not have a supported payment method
--     associated with the account. Amazon Web Services does not support
--     cards issued by financial institutions in Russia or Belarus. For
--     more information, see
--     <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/manage-general.html Managing your Amazon Web Services payments>.
--
-- -   INTERNAL_FAILURE: The account could not be created because of an
--     internal failure. Try again later. If the problem persists, contact
--     Amazon Web Services Customer Support.
--
-- -   MISSING_BUSINESS_VALIDATION: The Amazon Web Services account that
--     owns your organization has not received Business Validation.
--
-- -   MISSING_PAYMENT_INSTRUMENT: You must configure the management
--     account with a valid payment method, such as a credit card.
--
-- -   PENDING_BUSINESS_VALIDATION: The Amazon Web Services account that
--     owns your organization is still in the process of completing
--     business license validation.
--
-- -   UNKNOWN_BUSINESS_VALIDATION: The Amazon Web Services account that
--     owns your organization has an unknown issue with business license
--     validation.
createAccountStatus_failureReason :: Lens.Lens' CreateAccountStatus (Prelude.Maybe CreateAccountFailureReason)
createAccountStatus_failureReason :: Lens' CreateAccountStatus (Maybe CreateAccountFailureReason)
createAccountStatus_failureReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccountStatus' {Maybe CreateAccountFailureReason
failureReason :: Maybe CreateAccountFailureReason
$sel:failureReason:CreateAccountStatus' :: CreateAccountStatus -> Maybe CreateAccountFailureReason
failureReason} -> Maybe CreateAccountFailureReason
failureReason) (\s :: CreateAccountStatus
s@CreateAccountStatus' {} Maybe CreateAccountFailureReason
a -> CreateAccountStatus
s {$sel:failureReason:CreateAccountStatus' :: Maybe CreateAccountFailureReason
failureReason = Maybe CreateAccountFailureReason
a} :: CreateAccountStatus)

-- | If the account was created successfully, the unique identifier (ID) of
-- the new account in the Amazon Web Services GovCloud (US) Region.
createAccountStatus_govCloudAccountId :: Lens.Lens' CreateAccountStatus (Prelude.Maybe Prelude.Text)
createAccountStatus_govCloudAccountId :: Lens' CreateAccountStatus (Maybe Text)
createAccountStatus_govCloudAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccountStatus' {Maybe Text
govCloudAccountId :: Maybe Text
$sel:govCloudAccountId:CreateAccountStatus' :: CreateAccountStatus -> Maybe Text
govCloudAccountId} -> Maybe Text
govCloudAccountId) (\s :: CreateAccountStatus
s@CreateAccountStatus' {} Maybe Text
a -> CreateAccountStatus
s {$sel:govCloudAccountId:CreateAccountStatus' :: Maybe Text
govCloudAccountId = Maybe Text
a} :: CreateAccountStatus)

-- | The unique identifier (ID) that references this request. You get this
-- value from the response of the initial CreateAccount request to create
-- the account.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for a create account
-- request ID string requires \"car-\" followed by from 8 to 32 lowercase
-- letters or digits.
createAccountStatus_id :: Lens.Lens' CreateAccountStatus (Prelude.Maybe Prelude.Text)
createAccountStatus_id :: Lens' CreateAccountStatus (Maybe Text)
createAccountStatus_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccountStatus' {Maybe Text
id :: Maybe Text
$sel:id:CreateAccountStatus' :: CreateAccountStatus -> Maybe Text
id} -> Maybe Text
id) (\s :: CreateAccountStatus
s@CreateAccountStatus' {} Maybe Text
a -> CreateAccountStatus
s {$sel:id:CreateAccountStatus' :: Maybe Text
id = Maybe Text
a} :: CreateAccountStatus)

-- | The date and time that the request was made for the account creation.
createAccountStatus_requestedTimestamp :: Lens.Lens' CreateAccountStatus (Prelude.Maybe Prelude.UTCTime)
createAccountStatus_requestedTimestamp :: Lens' CreateAccountStatus (Maybe UTCTime)
createAccountStatus_requestedTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccountStatus' {Maybe POSIX
requestedTimestamp :: Maybe POSIX
$sel:requestedTimestamp:CreateAccountStatus' :: CreateAccountStatus -> Maybe POSIX
requestedTimestamp} -> Maybe POSIX
requestedTimestamp) (\s :: CreateAccountStatus
s@CreateAccountStatus' {} Maybe POSIX
a -> CreateAccountStatus
s {$sel:requestedTimestamp:CreateAccountStatus' :: Maybe POSIX
requestedTimestamp = Maybe POSIX
a} :: CreateAccountStatus) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The status of the asynchronous request to create an Amazon Web Services
-- account.
createAccountStatus_state :: Lens.Lens' CreateAccountStatus (Prelude.Maybe CreateAccountState)
createAccountStatus_state :: Lens' CreateAccountStatus (Maybe CreateAccountState)
createAccountStatus_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAccountStatus' {Maybe CreateAccountState
state :: Maybe CreateAccountState
$sel:state:CreateAccountStatus' :: CreateAccountStatus -> Maybe CreateAccountState
state} -> Maybe CreateAccountState
state) (\s :: CreateAccountStatus
s@CreateAccountStatus' {} Maybe CreateAccountState
a -> CreateAccountStatus
s {$sel:state:CreateAccountStatus' :: Maybe CreateAccountState
state = Maybe CreateAccountState
a} :: CreateAccountStatus)

instance Data.FromJSON CreateAccountStatus where
  parseJSON :: Value -> Parser CreateAccountStatus
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"CreateAccountStatus"
      ( \Object
x ->
          Maybe Text
-> Maybe (Sensitive Text)
-> Maybe POSIX
-> Maybe CreateAccountFailureReason
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe CreateAccountState
-> CreateAccountStatus
CreateAccountStatus'
            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
"AccountId")
            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
"AccountName")
            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
"CompletedTimestamp")
            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
"FailureReason")
            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
"GovCloudAccountId")
            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
"Id")
            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
"RequestedTimestamp")
            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
"State")
      )

instance Prelude.Hashable CreateAccountStatus where
  hashWithSalt :: Int -> CreateAccountStatus -> Int
hashWithSalt Int
_salt CreateAccountStatus' {Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
Maybe CreateAccountFailureReason
Maybe CreateAccountState
state :: Maybe CreateAccountState
requestedTimestamp :: Maybe POSIX
id :: Maybe Text
govCloudAccountId :: Maybe Text
failureReason :: Maybe CreateAccountFailureReason
completedTimestamp :: Maybe POSIX
accountName :: Maybe (Sensitive Text)
accountId :: Maybe Text
$sel:state:CreateAccountStatus' :: CreateAccountStatus -> Maybe CreateAccountState
$sel:requestedTimestamp:CreateAccountStatus' :: CreateAccountStatus -> Maybe POSIX
$sel:id:CreateAccountStatus' :: CreateAccountStatus -> Maybe Text
$sel:govCloudAccountId:CreateAccountStatus' :: CreateAccountStatus -> Maybe Text
$sel:failureReason:CreateAccountStatus' :: CreateAccountStatus -> Maybe CreateAccountFailureReason
$sel:completedTimestamp:CreateAccountStatus' :: CreateAccountStatus -> Maybe POSIX
$sel:accountName:CreateAccountStatus' :: CreateAccountStatus -> Maybe (Sensitive Text)
$sel:accountId:CreateAccountStatus' :: CreateAccountStatus -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
accountName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
completedTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateAccountFailureReason
failureReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
govCloudAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
requestedTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateAccountState
state

instance Prelude.NFData CreateAccountStatus where
  rnf :: CreateAccountStatus -> ()
rnf CreateAccountStatus' {Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
Maybe CreateAccountFailureReason
Maybe CreateAccountState
state :: Maybe CreateAccountState
requestedTimestamp :: Maybe POSIX
id :: Maybe Text
govCloudAccountId :: Maybe Text
failureReason :: Maybe CreateAccountFailureReason
completedTimestamp :: Maybe POSIX
accountName :: Maybe (Sensitive Text)
accountId :: Maybe Text
$sel:state:CreateAccountStatus' :: CreateAccountStatus -> Maybe CreateAccountState
$sel:requestedTimestamp:CreateAccountStatus' :: CreateAccountStatus -> Maybe POSIX
$sel:id:CreateAccountStatus' :: CreateAccountStatus -> Maybe Text
$sel:govCloudAccountId:CreateAccountStatus' :: CreateAccountStatus -> Maybe Text
$sel:failureReason:CreateAccountStatus' :: CreateAccountStatus -> Maybe CreateAccountFailureReason
$sel:completedTimestamp:CreateAccountStatus' :: CreateAccountStatus -> Maybe POSIX
$sel:accountName:CreateAccountStatus' :: CreateAccountStatus -> Maybe (Sensitive Text)
$sel:accountId:CreateAccountStatus' :: CreateAccountStatus -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
accountName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
completedTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CreateAccountFailureReason
failureReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
govCloudAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
requestedTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CreateAccountState
state