{-# 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.Route53Resolver.DeleteFirewallRuleGroup
-- 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 firewall rule group.
module Amazonka.Route53Resolver.DeleteFirewallRuleGroup
  ( -- * Creating a Request
    DeleteFirewallRuleGroup (..),
    newDeleteFirewallRuleGroup,

    -- * Request Lenses
    deleteFirewallRuleGroup_firewallRuleGroupId,

    -- * Destructuring the Response
    DeleteFirewallRuleGroupResponse (..),
    newDeleteFirewallRuleGroupResponse,

    -- * Response Lenses
    deleteFirewallRuleGroupResponse_firewallRuleGroup,
    deleteFirewallRuleGroupResponse_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.Route53Resolver.Types

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

-- |
-- Create a value of 'DeleteFirewallRuleGroup' 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:
--
-- 'firewallRuleGroupId', 'deleteFirewallRuleGroup_firewallRuleGroupId' - The unique identifier of the firewall rule group that you want to
-- delete.
newDeleteFirewallRuleGroup ::
  -- | 'firewallRuleGroupId'
  Prelude.Text ->
  DeleteFirewallRuleGroup
newDeleteFirewallRuleGroup :: Text -> DeleteFirewallRuleGroup
newDeleteFirewallRuleGroup Text
pFirewallRuleGroupId_ =
  DeleteFirewallRuleGroup'
    { $sel:firewallRuleGroupId:DeleteFirewallRuleGroup' :: Text
firewallRuleGroupId =
        Text
pFirewallRuleGroupId_
    }

-- | The unique identifier of the firewall rule group that you want to
-- delete.
deleteFirewallRuleGroup_firewallRuleGroupId :: Lens.Lens' DeleteFirewallRuleGroup Prelude.Text
deleteFirewallRuleGroup_firewallRuleGroupId :: Lens' DeleteFirewallRuleGroup Text
deleteFirewallRuleGroup_firewallRuleGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteFirewallRuleGroup' {Text
firewallRuleGroupId :: Text
$sel:firewallRuleGroupId:DeleteFirewallRuleGroup' :: DeleteFirewallRuleGroup -> Text
firewallRuleGroupId} -> Text
firewallRuleGroupId) (\s :: DeleteFirewallRuleGroup
s@DeleteFirewallRuleGroup' {} Text
a -> DeleteFirewallRuleGroup
s {$sel:firewallRuleGroupId:DeleteFirewallRuleGroup' :: Text
firewallRuleGroupId = Text
a} :: DeleteFirewallRuleGroup)

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

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

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

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

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

-- | /See:/ 'newDeleteFirewallRuleGroupResponse' smart constructor.
data DeleteFirewallRuleGroupResponse = DeleteFirewallRuleGroupResponse'
  { -- | A collection of rules used to filter DNS network traffic.
    DeleteFirewallRuleGroupResponse -> Maybe FirewallRuleGroup
firewallRuleGroup :: Prelude.Maybe FirewallRuleGroup,
    -- | The response's http status code.
    DeleteFirewallRuleGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteFirewallRuleGroupResponse
-> DeleteFirewallRuleGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteFirewallRuleGroupResponse
-> DeleteFirewallRuleGroupResponse -> Bool
$c/= :: DeleteFirewallRuleGroupResponse
-> DeleteFirewallRuleGroupResponse -> Bool
== :: DeleteFirewallRuleGroupResponse
-> DeleteFirewallRuleGroupResponse -> Bool
$c== :: DeleteFirewallRuleGroupResponse
-> DeleteFirewallRuleGroupResponse -> Bool
Prelude.Eq, ReadPrec [DeleteFirewallRuleGroupResponse]
ReadPrec DeleteFirewallRuleGroupResponse
Int -> ReadS DeleteFirewallRuleGroupResponse
ReadS [DeleteFirewallRuleGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteFirewallRuleGroupResponse]
$creadListPrec :: ReadPrec [DeleteFirewallRuleGroupResponse]
readPrec :: ReadPrec DeleteFirewallRuleGroupResponse
$creadPrec :: ReadPrec DeleteFirewallRuleGroupResponse
readList :: ReadS [DeleteFirewallRuleGroupResponse]
$creadList :: ReadS [DeleteFirewallRuleGroupResponse]
readsPrec :: Int -> ReadS DeleteFirewallRuleGroupResponse
$creadsPrec :: Int -> ReadS DeleteFirewallRuleGroupResponse
Prelude.Read, Int -> DeleteFirewallRuleGroupResponse -> ShowS
[DeleteFirewallRuleGroupResponse] -> ShowS
DeleteFirewallRuleGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteFirewallRuleGroupResponse] -> ShowS
$cshowList :: [DeleteFirewallRuleGroupResponse] -> ShowS
show :: DeleteFirewallRuleGroupResponse -> String
$cshow :: DeleteFirewallRuleGroupResponse -> String
showsPrec :: Int -> DeleteFirewallRuleGroupResponse -> ShowS
$cshowsPrec :: Int -> DeleteFirewallRuleGroupResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteFirewallRuleGroupResponse x
-> DeleteFirewallRuleGroupResponse
forall x.
DeleteFirewallRuleGroupResponse
-> Rep DeleteFirewallRuleGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteFirewallRuleGroupResponse x
-> DeleteFirewallRuleGroupResponse
$cfrom :: forall x.
DeleteFirewallRuleGroupResponse
-> Rep DeleteFirewallRuleGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteFirewallRuleGroupResponse' 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:
--
-- 'firewallRuleGroup', 'deleteFirewallRuleGroupResponse_firewallRuleGroup' - A collection of rules used to filter DNS network traffic.
--
-- 'httpStatus', 'deleteFirewallRuleGroupResponse_httpStatus' - The response's http status code.
newDeleteFirewallRuleGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteFirewallRuleGroupResponse
newDeleteFirewallRuleGroupResponse :: Int -> DeleteFirewallRuleGroupResponse
newDeleteFirewallRuleGroupResponse Int
pHttpStatus_ =
  DeleteFirewallRuleGroupResponse'
    { $sel:firewallRuleGroup:DeleteFirewallRuleGroupResponse' :: Maybe FirewallRuleGroup
firewallRuleGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteFirewallRuleGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A collection of rules used to filter DNS network traffic.
deleteFirewallRuleGroupResponse_firewallRuleGroup :: Lens.Lens' DeleteFirewallRuleGroupResponse (Prelude.Maybe FirewallRuleGroup)
deleteFirewallRuleGroupResponse_firewallRuleGroup :: Lens' DeleteFirewallRuleGroupResponse (Maybe FirewallRuleGroup)
deleteFirewallRuleGroupResponse_firewallRuleGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteFirewallRuleGroupResponse' {Maybe FirewallRuleGroup
firewallRuleGroup :: Maybe FirewallRuleGroup
$sel:firewallRuleGroup:DeleteFirewallRuleGroupResponse' :: DeleteFirewallRuleGroupResponse -> Maybe FirewallRuleGroup
firewallRuleGroup} -> Maybe FirewallRuleGroup
firewallRuleGroup) (\s :: DeleteFirewallRuleGroupResponse
s@DeleteFirewallRuleGroupResponse' {} Maybe FirewallRuleGroup
a -> DeleteFirewallRuleGroupResponse
s {$sel:firewallRuleGroup:DeleteFirewallRuleGroupResponse' :: Maybe FirewallRuleGroup
firewallRuleGroup = Maybe FirewallRuleGroup
a} :: DeleteFirewallRuleGroupResponse)

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

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