{-# 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.Shield.DeleteProtection
-- 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 an Shield Advanced Protection.
module Amazonka.Shield.DeleteProtection
  ( -- * Creating a Request
    DeleteProtection (..),
    newDeleteProtection,

    -- * Request Lenses
    deleteProtection_protectionId,

    -- * Destructuring the Response
    DeleteProtectionResponse (..),
    newDeleteProtectionResponse,

    -- * Response Lenses
    deleteProtectionResponse_httpStatus,
  )
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.Shield.Types

-- | /See:/ 'newDeleteProtection' smart constructor.
data DeleteProtection = DeleteProtection'
  { -- | The unique identifier (ID) for the Protection object to be deleted.
    DeleteProtection -> Text
protectionId :: Prelude.Text
  }
  deriving (DeleteProtection -> DeleteProtection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteProtection -> DeleteProtection -> Bool
$c/= :: DeleteProtection -> DeleteProtection -> Bool
== :: DeleteProtection -> DeleteProtection -> Bool
$c== :: DeleteProtection -> DeleteProtection -> Bool
Prelude.Eq, ReadPrec [DeleteProtection]
ReadPrec DeleteProtection
Int -> ReadS DeleteProtection
ReadS [DeleteProtection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteProtection]
$creadListPrec :: ReadPrec [DeleteProtection]
readPrec :: ReadPrec DeleteProtection
$creadPrec :: ReadPrec DeleteProtection
readList :: ReadS [DeleteProtection]
$creadList :: ReadS [DeleteProtection]
readsPrec :: Int -> ReadS DeleteProtection
$creadsPrec :: Int -> ReadS DeleteProtection
Prelude.Read, Int -> DeleteProtection -> ShowS
[DeleteProtection] -> ShowS
DeleteProtection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteProtection] -> ShowS
$cshowList :: [DeleteProtection] -> ShowS
show :: DeleteProtection -> String
$cshow :: DeleteProtection -> String
showsPrec :: Int -> DeleteProtection -> ShowS
$cshowsPrec :: Int -> DeleteProtection -> ShowS
Prelude.Show, forall x. Rep DeleteProtection x -> DeleteProtection
forall x. DeleteProtection -> Rep DeleteProtection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteProtection x -> DeleteProtection
$cfrom :: forall x. DeleteProtection -> Rep DeleteProtection x
Prelude.Generic)

-- |
-- Create a value of 'DeleteProtection' 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:
--
-- 'protectionId', 'deleteProtection_protectionId' - The unique identifier (ID) for the Protection object to be deleted.
newDeleteProtection ::
  -- | 'protectionId'
  Prelude.Text ->
  DeleteProtection
newDeleteProtection :: Text -> DeleteProtection
newDeleteProtection Text
pProtectionId_ =
  DeleteProtection' {$sel:protectionId:DeleteProtection' :: Text
protectionId = Text
pProtectionId_}

-- | The unique identifier (ID) for the Protection object to be deleted.
deleteProtection_protectionId :: Lens.Lens' DeleteProtection Prelude.Text
deleteProtection_protectionId :: Lens' DeleteProtection Text
deleteProtection_protectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteProtection' {Text
protectionId :: Text
$sel:protectionId:DeleteProtection' :: DeleteProtection -> Text
protectionId} -> Text
protectionId) (\s :: DeleteProtection
s@DeleteProtection' {} Text
a -> DeleteProtection
s {$sel:protectionId:DeleteProtection' :: Text
protectionId = Text
a} :: DeleteProtection)

instance Core.AWSRequest DeleteProtection where
  type
    AWSResponse DeleteProtection =
      DeleteProtectionResponse
  request :: (Service -> Service)
-> DeleteProtection -> Request DeleteProtection
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 DeleteProtection
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteProtection)))
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 -> DeleteProtectionResponse
DeleteProtectionResponse'
            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 DeleteProtection where
  hashWithSalt :: Int -> DeleteProtection -> Int
hashWithSalt Int
_salt DeleteProtection' {Text
protectionId :: Text
$sel:protectionId:DeleteProtection' :: DeleteProtection -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
protectionId

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

instance Data.ToHeaders DeleteProtection where
  toHeaders :: DeleteProtection -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"AWSShield_20160616.DeleteProtection" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

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

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

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

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

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