{-# 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.MemoryDb.DeleteSubnetGroup
-- 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 a subnet group. You cannot delete a default subnet group or one
-- that is associated with any clusters.
module Amazonka.MemoryDb.DeleteSubnetGroup
  ( -- * Creating a Request
    DeleteSubnetGroup (..),
    newDeleteSubnetGroup,

    -- * Request Lenses
    deleteSubnetGroup_subnetGroupName,

    -- * Destructuring the Response
    DeleteSubnetGroupResponse (..),
    newDeleteSubnetGroupResponse,

    -- * Response Lenses
    deleteSubnetGroupResponse_subnetGroup,
    deleteSubnetGroupResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MemoryDb.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDeleteSubnetGroup' smart constructor.
data DeleteSubnetGroup = DeleteSubnetGroup'
  { -- | The name of the subnet group to delete
    DeleteSubnetGroup -> Text
subnetGroupName :: Prelude.Text
  }
  deriving (DeleteSubnetGroup -> DeleteSubnetGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteSubnetGroup -> DeleteSubnetGroup -> Bool
$c/= :: DeleteSubnetGroup -> DeleteSubnetGroup -> Bool
== :: DeleteSubnetGroup -> DeleteSubnetGroup -> Bool
$c== :: DeleteSubnetGroup -> DeleteSubnetGroup -> Bool
Prelude.Eq, ReadPrec [DeleteSubnetGroup]
ReadPrec DeleteSubnetGroup
Int -> ReadS DeleteSubnetGroup
ReadS [DeleteSubnetGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteSubnetGroup]
$creadListPrec :: ReadPrec [DeleteSubnetGroup]
readPrec :: ReadPrec DeleteSubnetGroup
$creadPrec :: ReadPrec DeleteSubnetGroup
readList :: ReadS [DeleteSubnetGroup]
$creadList :: ReadS [DeleteSubnetGroup]
readsPrec :: Int -> ReadS DeleteSubnetGroup
$creadsPrec :: Int -> ReadS DeleteSubnetGroup
Prelude.Read, Int -> DeleteSubnetGroup -> ShowS
[DeleteSubnetGroup] -> ShowS
DeleteSubnetGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteSubnetGroup] -> ShowS
$cshowList :: [DeleteSubnetGroup] -> ShowS
show :: DeleteSubnetGroup -> String
$cshow :: DeleteSubnetGroup -> String
showsPrec :: Int -> DeleteSubnetGroup -> ShowS
$cshowsPrec :: Int -> DeleteSubnetGroup -> ShowS
Prelude.Show, forall x. Rep DeleteSubnetGroup x -> DeleteSubnetGroup
forall x. DeleteSubnetGroup -> Rep DeleteSubnetGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteSubnetGroup x -> DeleteSubnetGroup
$cfrom :: forall x. DeleteSubnetGroup -> Rep DeleteSubnetGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeleteSubnetGroup' 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:
--
-- 'subnetGroupName', 'deleteSubnetGroup_subnetGroupName' - The name of the subnet group to delete
newDeleteSubnetGroup ::
  -- | 'subnetGroupName'
  Prelude.Text ->
  DeleteSubnetGroup
newDeleteSubnetGroup :: Text -> DeleteSubnetGroup
newDeleteSubnetGroup Text
pSubnetGroupName_ =
  DeleteSubnetGroup'
    { $sel:subnetGroupName:DeleteSubnetGroup' :: Text
subnetGroupName =
        Text
pSubnetGroupName_
    }

-- | The name of the subnet group to delete
deleteSubnetGroup_subnetGroupName :: Lens.Lens' DeleteSubnetGroup Prelude.Text
deleteSubnetGroup_subnetGroupName :: Lens' DeleteSubnetGroup Text
deleteSubnetGroup_subnetGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSubnetGroup' {Text
subnetGroupName :: Text
$sel:subnetGroupName:DeleteSubnetGroup' :: DeleteSubnetGroup -> Text
subnetGroupName} -> Text
subnetGroupName) (\s :: DeleteSubnetGroup
s@DeleteSubnetGroup' {} Text
a -> DeleteSubnetGroup
s {$sel:subnetGroupName:DeleteSubnetGroup' :: Text
subnetGroupName = Text
a} :: DeleteSubnetGroup)

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

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

instance Data.ToHeaders DeleteSubnetGroup where
  toHeaders :: DeleteSubnetGroup -> 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
"AmazonMemoryDB.DeleteSubnetGroup" ::
                          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 DeleteSubnetGroup where
  toJSON :: DeleteSubnetGroup -> Value
toJSON DeleteSubnetGroup' {Text
subnetGroupName :: Text
$sel:subnetGroupName:DeleteSubnetGroup' :: DeleteSubnetGroup -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"SubnetGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
subnetGroupName)
          ]
      )

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

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

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

-- |
-- Create a value of 'DeleteSubnetGroupResponse' 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:
--
-- 'subnetGroup', 'deleteSubnetGroupResponse_subnetGroup' - The subnet group object that has been deleted.
--
-- 'httpStatus', 'deleteSubnetGroupResponse_httpStatus' - The response's http status code.
newDeleteSubnetGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteSubnetGroupResponse
newDeleteSubnetGroupResponse :: Int -> DeleteSubnetGroupResponse
newDeleteSubnetGroupResponse Int
pHttpStatus_ =
  DeleteSubnetGroupResponse'
    { $sel:subnetGroup:DeleteSubnetGroupResponse' :: Maybe SubnetGroup
subnetGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteSubnetGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The subnet group object that has been deleted.
deleteSubnetGroupResponse_subnetGroup :: Lens.Lens' DeleteSubnetGroupResponse (Prelude.Maybe SubnetGroup)
deleteSubnetGroupResponse_subnetGroup :: Lens' DeleteSubnetGroupResponse (Maybe SubnetGroup)
deleteSubnetGroupResponse_subnetGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSubnetGroupResponse' {Maybe SubnetGroup
subnetGroup :: Maybe SubnetGroup
$sel:subnetGroup:DeleteSubnetGroupResponse' :: DeleteSubnetGroupResponse -> Maybe SubnetGroup
subnetGroup} -> Maybe SubnetGroup
subnetGroup) (\s :: DeleteSubnetGroupResponse
s@DeleteSubnetGroupResponse' {} Maybe SubnetGroup
a -> DeleteSubnetGroupResponse
s {$sel:subnetGroup:DeleteSubnetGroupResponse' :: Maybe SubnetGroup
subnetGroup = Maybe SubnetGroup
a} :: DeleteSubnetGroupResponse)

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

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