{-# 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.Organizations.CloseAccount
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Closes an Amazon Web Services member account within an organization. You
-- can\'t close the management account with this API. This is an
-- asynchronous request that Amazon Web Services performs in the
-- background. Because @CloseAccount@ operates asynchronously, it can
-- return a successful completion message even though account closure might
-- still be in progress. You need to wait a few minutes before the account
-- is fully closed. To check the status of the request, do one of the
-- following:
--
-- -   Use the @AccountId@ that you sent in the @CloseAccount@ request to
--     provide as a parameter to the DescribeAccount operation.
--
--     While the close account request is in progress, Account status will
--     indicate PENDING_CLOSURE. When the close account request completes,
--     the status will change to SUSPENDED.
--
-- -   Check the CloudTrail log for the @CloseAccountResult@ event that
--     gets published after the account closes successfully. For
--     information on using CloudTrail with Organizations, see
--     <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_security_incident-response.html#orgs_cloudtrail-integration Logging and monitoring in Organizations>
--     in the /Organizations User Guide./
--
-- -   You can only close 10% of active member accounts within a rolling 30
--     day period. This quota is not bound by a calendar month, but starts
--     when you close an account. Within 30 days of that initial account
--     closure, you can\'t exceed the 10% account closure limit.
--
-- -   To reinstate a closed account, contact Amazon Web Services Support
--     within the 90-day grace period while the account is in SUSPENDED
--     status.
--
-- -   If the Amazon Web Services account you attempt to close is linked to
--     an Amazon Web Services GovCloud (US) account, the @CloseAccount@
--     request will close both accounts. To learn important pre-closure
--     details, see
--     <https://docs.aws.amazon.com/govcloud-us/latest/UserGuide/Closing-govcloud-account.html Closing an Amazon Web Services GovCloud (US) account>
--     in the /Amazon Web Services GovCloud User Guide/.
--
-- For more information about closing accounts, see
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_accounts_close.html Closing an Amazon Web Services account>
-- in the /Organizations User Guide./
module Amazonka.Organizations.CloseAccount
  ( -- * Creating a Request
    CloseAccount (..),
    newCloseAccount,

    -- * Request Lenses
    closeAccount_accountId,

    -- * Destructuring the Response
    CloseAccountResponse (..),
    newCloseAccountResponse,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCloseAccount' smart constructor.
data CloseAccount = CloseAccount'
  { -- | Retrieves the Amazon Web Services account Id for the current
    -- @CloseAccount@ API request.
    CloseAccount -> Text
accountId :: Prelude.Text
  }
  deriving (CloseAccount -> CloseAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CloseAccount -> CloseAccount -> Bool
$c/= :: CloseAccount -> CloseAccount -> Bool
== :: CloseAccount -> CloseAccount -> Bool
$c== :: CloseAccount -> CloseAccount -> Bool
Prelude.Eq, ReadPrec [CloseAccount]
ReadPrec CloseAccount
Int -> ReadS CloseAccount
ReadS [CloseAccount]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CloseAccount]
$creadListPrec :: ReadPrec [CloseAccount]
readPrec :: ReadPrec CloseAccount
$creadPrec :: ReadPrec CloseAccount
readList :: ReadS [CloseAccount]
$creadList :: ReadS [CloseAccount]
readsPrec :: Int -> ReadS CloseAccount
$creadsPrec :: Int -> ReadS CloseAccount
Prelude.Read, Int -> CloseAccount -> ShowS
[CloseAccount] -> ShowS
CloseAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CloseAccount] -> ShowS
$cshowList :: [CloseAccount] -> ShowS
show :: CloseAccount -> String
$cshow :: CloseAccount -> String
showsPrec :: Int -> CloseAccount -> ShowS
$cshowsPrec :: Int -> CloseAccount -> ShowS
Prelude.Show, forall x. Rep CloseAccount x -> CloseAccount
forall x. CloseAccount -> Rep CloseAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CloseAccount x -> CloseAccount
$cfrom :: forall x. CloseAccount -> Rep CloseAccount x
Prelude.Generic)

-- |
-- Create a value of 'CloseAccount' 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', 'closeAccount_accountId' - Retrieves the Amazon Web Services account Id for the current
-- @CloseAccount@ API request.
newCloseAccount ::
  -- | 'accountId'
  Prelude.Text ->
  CloseAccount
newCloseAccount :: Text -> CloseAccount
newCloseAccount Text
pAccountId_ =
  CloseAccount' {$sel:accountId:CloseAccount' :: Text
accountId = Text
pAccountId_}

-- | Retrieves the Amazon Web Services account Id for the current
-- @CloseAccount@ API request.
closeAccount_accountId :: Lens.Lens' CloseAccount Prelude.Text
closeAccount_accountId :: Lens' CloseAccount Text
closeAccount_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CloseAccount' {Text
accountId :: Text
$sel:accountId:CloseAccount' :: CloseAccount -> Text
accountId} -> Text
accountId) (\s :: CloseAccount
s@CloseAccount' {} Text
a -> CloseAccount
s {$sel:accountId:CloseAccount' :: Text
accountId = Text
a} :: CloseAccount)

instance Core.AWSRequest CloseAccount where
  type AWSResponse CloseAccount = CloseAccountResponse
  request :: (Service -> Service) -> CloseAccount -> Request CloseAccount
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 CloseAccount
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CloseAccount)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull CloseAccountResponse
CloseAccountResponse'

instance Prelude.Hashable CloseAccount where
  hashWithSalt :: Int -> CloseAccount -> Int
hashWithSalt Int
_salt CloseAccount' {Text
accountId :: Text
$sel:accountId:CloseAccount' :: CloseAccount -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId

instance Prelude.NFData CloseAccount where
  rnf :: CloseAccount -> ()
rnf CloseAccount' {Text
accountId :: Text
$sel:accountId:CloseAccount' :: CloseAccount -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
accountId

instance Data.ToHeaders CloseAccount where
  toHeaders :: CloseAccount -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"AWSOrganizationsV20161128.CloseAccount" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CloseAccount where
  toJSON :: CloseAccount -> Value
toJSON CloseAccount' {Text
accountId :: Text
$sel:accountId:CloseAccount' :: CloseAccount -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"AccountId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
accountId)]
      )

instance Data.ToPath CloseAccount where
  toPath :: CloseAccount -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newCloseAccountResponse' smart constructor.
data CloseAccountResponse = CloseAccountResponse'
  {
  }
  deriving (CloseAccountResponse -> CloseAccountResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CloseAccountResponse -> CloseAccountResponse -> Bool
$c/= :: CloseAccountResponse -> CloseAccountResponse -> Bool
== :: CloseAccountResponse -> CloseAccountResponse -> Bool
$c== :: CloseAccountResponse -> CloseAccountResponse -> Bool
Prelude.Eq, ReadPrec [CloseAccountResponse]
ReadPrec CloseAccountResponse
Int -> ReadS CloseAccountResponse
ReadS [CloseAccountResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CloseAccountResponse]
$creadListPrec :: ReadPrec [CloseAccountResponse]
readPrec :: ReadPrec CloseAccountResponse
$creadPrec :: ReadPrec CloseAccountResponse
readList :: ReadS [CloseAccountResponse]
$creadList :: ReadS [CloseAccountResponse]
readsPrec :: Int -> ReadS CloseAccountResponse
$creadsPrec :: Int -> ReadS CloseAccountResponse
Prelude.Read, Int -> CloseAccountResponse -> ShowS
[CloseAccountResponse] -> ShowS
CloseAccountResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CloseAccountResponse] -> ShowS
$cshowList :: [CloseAccountResponse] -> ShowS
show :: CloseAccountResponse -> String
$cshow :: CloseAccountResponse -> String
showsPrec :: Int -> CloseAccountResponse -> ShowS
$cshowsPrec :: Int -> CloseAccountResponse -> ShowS
Prelude.Show, forall x. Rep CloseAccountResponse x -> CloseAccountResponse
forall x. CloseAccountResponse -> Rep CloseAccountResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CloseAccountResponse x -> CloseAccountResponse
$cfrom :: forall x. CloseAccountResponse -> Rep CloseAccountResponse x
Prelude.Generic)

-- |
-- Create a value of 'CloseAccountResponse' 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.
newCloseAccountResponse ::
  CloseAccountResponse
newCloseAccountResponse :: CloseAccountResponse
newCloseAccountResponse = CloseAccountResponse
CloseAccountResponse'

instance Prelude.NFData CloseAccountResponse where
  rnf :: CloseAccountResponse -> ()
rnf CloseAccountResponse
_ = ()