{-# 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.AuditManager.DeregisterAccount
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deregisters an account in Audit Manager.
--
-- Before you deregister, you can use the
-- <https://docs.aws.amazon.com/audit-manager/latest/APIReference/API_UpdateSettings.html UpdateSettings>
-- API operation to set your preferred data retention policy. By default,
-- Audit Manager retains your data. If you want to delete your data, you
-- can use the @DeregistrationPolicy@ attribute to request the deletion of
-- your data.
--
-- For more information about data retention, see
-- <https://docs.aws.amazon.com/audit-manager/latest/userguide/data-protection.html Data Protection>
-- in the /Audit Manager User Guide/.
module Amazonka.AuditManager.DeregisterAccount
  ( -- * Creating a Request
    DeregisterAccount (..),
    newDeregisterAccount,

    -- * Destructuring the Response
    DeregisterAccountResponse (..),
    newDeregisterAccountResponse,

    -- * Response Lenses
    deregisterAccountResponse_status,
    deregisterAccountResponse_httpStatus,
  )
where

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

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

instance Core.AWSRequest DeregisterAccount where
  type
    AWSResponse DeregisterAccount =
      DeregisterAccountResponse
  request :: (Service -> Service)
-> DeregisterAccount -> Request DeregisterAccount
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 DeregisterAccount
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeregisterAccount)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe AccountStatus -> Int -> DeregisterAccountResponse
DeregisterAccountResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"status")
            forall (f :: * -> *) a b. Applicative f => 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 DeregisterAccount where
  hashWithSalt :: Int -> DeregisterAccount -> Int
hashWithSalt Int
_salt DeregisterAccount
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

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

instance Data.ToHeaders DeregisterAccount where
  toHeaders :: DeregisterAccount -> 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 DeregisterAccount where
  toJSON :: DeregisterAccount -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

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

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

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

-- |
-- Create a value of 'DeregisterAccountResponse' 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:
--
-- 'status', 'deregisterAccountResponse_status' - The registration status of the account.
--
-- 'httpStatus', 'deregisterAccountResponse_httpStatus' - The response's http status code.
newDeregisterAccountResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeregisterAccountResponse
newDeregisterAccountResponse :: Int -> DeregisterAccountResponse
newDeregisterAccountResponse Int
pHttpStatus_ =
  DeregisterAccountResponse'
    { $sel:status:DeregisterAccountResponse' :: Maybe AccountStatus
status =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeregisterAccountResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The registration status of the account.
deregisterAccountResponse_status :: Lens.Lens' DeregisterAccountResponse (Prelude.Maybe AccountStatus)
deregisterAccountResponse_status :: Lens' DeregisterAccountResponse (Maybe AccountStatus)
deregisterAccountResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeregisterAccountResponse' {Maybe AccountStatus
status :: Maybe AccountStatus
$sel:status:DeregisterAccountResponse' :: DeregisterAccountResponse -> Maybe AccountStatus
status} -> Maybe AccountStatus
status) (\s :: DeregisterAccountResponse
s@DeregisterAccountResponse' {} Maybe AccountStatus
a -> DeregisterAccountResponse
s {$sel:status:DeregisterAccountResponse' :: Maybe AccountStatus
status = Maybe AccountStatus
a} :: DeregisterAccountResponse)

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

instance Prelude.NFData DeregisterAccountResponse where
  rnf :: DeregisterAccountResponse -> ()
rnf DeregisterAccountResponse' {Int
Maybe AccountStatus
httpStatus :: Int
status :: Maybe AccountStatus
$sel:httpStatus:DeregisterAccountResponse' :: DeregisterAccountResponse -> Int
$sel:status:DeregisterAccountResponse' :: DeregisterAccountResponse -> Maybe AccountStatus
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AccountStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus