{-# 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.Chime.DeleteAccount
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes the specified Amazon Chime account. You must suspend all users
-- before deleting @Team@ account. You can use the BatchSuspendUser action
-- to dodo.
--
-- For @EnterpriseLWA@ and @EnterpriseAD@ accounts, you must release the
-- claimed domains for your Amazon Chime account before deletion. As soon
-- as you release the domain, all users under that account are suspended.
--
-- Deleted accounts appear in your @Disabled@ accounts list for 90 days. To
-- restore deleted account from your @Disabled@ accounts list, you must
-- contact AWS Support.
--
-- After 90 days, deleted accounts are permanently removed from your
-- @Disabled@ accounts list.
module Amazonka.Chime.DeleteAccount
  ( -- * Creating a Request
    DeleteAccount (..),
    newDeleteAccount,

    -- * Request Lenses
    deleteAccount_accountId,

    -- * Destructuring the Response
    DeleteAccountResponse (..),
    newDeleteAccountResponse,

    -- * Response Lenses
    deleteAccountResponse_httpStatus,
  )
where

import Amazonka.Chime.Types
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

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

-- |
-- Create a value of 'DeleteAccount' 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', 'deleteAccount_accountId' - The Amazon Chime account ID.
newDeleteAccount ::
  -- | 'accountId'
  Prelude.Text ->
  DeleteAccount
newDeleteAccount :: Text -> DeleteAccount
newDeleteAccount Text
pAccountId_ =
  DeleteAccount' {$sel:accountId:DeleteAccount' :: Text
accountId = Text
pAccountId_}

-- | The Amazon Chime account ID.
deleteAccount_accountId :: Lens.Lens' DeleteAccount Prelude.Text
deleteAccount_accountId :: Lens' DeleteAccount Text
deleteAccount_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAccount' {Text
accountId :: Text
$sel:accountId:DeleteAccount' :: DeleteAccount -> Text
accountId} -> Text
accountId) (\s :: DeleteAccount
s@DeleteAccount' {} Text
a -> DeleteAccount
s {$sel:accountId:DeleteAccount' :: Text
accountId = Text
a} :: DeleteAccount)

instance Core.AWSRequest DeleteAccount where
  type
    AWSResponse DeleteAccount =
      DeleteAccountResponse
  request :: (Service -> Service) -> DeleteAccount -> Request DeleteAccount
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteAccount
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteAccount)))
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 -> DeleteAccountResponse
DeleteAccountResponse'
            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 DeleteAccount where
  hashWithSalt :: Int -> DeleteAccount -> Int
hashWithSalt Int
_salt DeleteAccount' {Text
accountId :: Text
$sel:accountId:DeleteAccount' :: DeleteAccount -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId

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

instance Data.ToHeaders DeleteAccount where
  toHeaders :: DeleteAccount -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DeleteAccount where
  toPath :: DeleteAccount -> ByteString
toPath DeleteAccount' {Text
accountId :: Text
$sel:accountId:DeleteAccount' :: DeleteAccount -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/accounts/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
accountId]

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

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

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

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

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