{-# 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.SecurityLake.DeleteDatalakeExceptionsSubscription
-- 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 notification subscription in Amazon Security Lake
-- for the organization you specify.
module Amazonka.SecurityLake.DeleteDatalakeExceptionsSubscription
  ( -- * Creating a Request
    DeleteDatalakeExceptionsSubscription (..),
    newDeleteDatalakeExceptionsSubscription,

    -- * Destructuring the Response
    DeleteDatalakeExceptionsSubscriptionResponse (..),
    newDeleteDatalakeExceptionsSubscriptionResponse,

    -- * Response Lenses
    deleteDatalakeExceptionsSubscriptionResponse_httpStatus,
    deleteDatalakeExceptionsSubscriptionResponse_status,
  )
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.SecurityLake.Types

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

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

instance
  Core.AWSRequest
    DeleteDatalakeExceptionsSubscription
  where
  type
    AWSResponse DeleteDatalakeExceptionsSubscription =
      DeleteDatalakeExceptionsSubscriptionResponse
  request :: (Service -> Service)
-> DeleteDatalakeExceptionsSubscription
-> Request DeleteDatalakeExceptionsSubscription
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 DeleteDatalakeExceptionsSubscription
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse DeleteDatalakeExceptionsSubscription)))
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 ->
          Int -> Text -> DeleteDatalakeExceptionsSubscriptionResponse
DeleteDatalakeExceptionsSubscriptionResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"status")
      )

instance
  Prelude.Hashable
    DeleteDatalakeExceptionsSubscription
  where
  hashWithSalt :: Int -> DeleteDatalakeExceptionsSubscription -> Int
hashWithSalt Int
_salt DeleteDatalakeExceptionsSubscription
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

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

instance
  Data.ToHeaders
    DeleteDatalakeExceptionsSubscription
  where
  toHeaders :: DeleteDatalakeExceptionsSubscription -> 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.ToPath
    DeleteDatalakeExceptionsSubscription
  where
  toPath :: DeleteDatalakeExceptionsSubscription -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/v1/datalake/exceptions/subscription"

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

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

-- |
-- Create a value of 'DeleteDatalakeExceptionsSubscriptionResponse' 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', 'deleteDatalakeExceptionsSubscriptionResponse_httpStatus' - The response's http status code.
--
-- 'status', 'deleteDatalakeExceptionsSubscriptionResponse_status' - Retrieves the status of the delete Security Lake operation for an
-- account.
newDeleteDatalakeExceptionsSubscriptionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'status'
  Prelude.Text ->
  DeleteDatalakeExceptionsSubscriptionResponse
newDeleteDatalakeExceptionsSubscriptionResponse :: Int -> Text -> DeleteDatalakeExceptionsSubscriptionResponse
newDeleteDatalakeExceptionsSubscriptionResponse
  Int
pHttpStatus_
  Text
pStatus_ =
    DeleteDatalakeExceptionsSubscriptionResponse'
      { $sel:httpStatus:DeleteDatalakeExceptionsSubscriptionResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:status:DeleteDatalakeExceptionsSubscriptionResponse' :: Text
status = Text
pStatus_
      }

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

-- | Retrieves the status of the delete Security Lake operation for an
-- account.
deleteDatalakeExceptionsSubscriptionResponse_status :: Lens.Lens' DeleteDatalakeExceptionsSubscriptionResponse Prelude.Text
deleteDatalakeExceptionsSubscriptionResponse_status :: Lens' DeleteDatalakeExceptionsSubscriptionResponse Text
deleteDatalakeExceptionsSubscriptionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDatalakeExceptionsSubscriptionResponse' {Text
status :: Text
$sel:status:DeleteDatalakeExceptionsSubscriptionResponse' :: DeleteDatalakeExceptionsSubscriptionResponse -> Text
status} -> Text
status) (\s :: DeleteDatalakeExceptionsSubscriptionResponse
s@DeleteDatalakeExceptionsSubscriptionResponse' {} Text
a -> DeleteDatalakeExceptionsSubscriptionResponse
s {$sel:status:DeleteDatalakeExceptionsSubscriptionResponse' :: Text
status = Text
a} :: DeleteDatalakeExceptionsSubscriptionResponse)

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