{-# 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.GetFirewallRuleGroupAssociation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a firewall rule group association, which enables DNS filtering
-- for a VPC with one rule group. A VPC can have more than one firewall
-- rule group association, and a rule group can be associated with more
-- than one VPC.
module Amazonka.Route53Resolver.GetFirewallRuleGroupAssociation
  ( -- * Creating a Request
    GetFirewallRuleGroupAssociation (..),
    newGetFirewallRuleGroupAssociation,

    -- * Request Lenses
    getFirewallRuleGroupAssociation_firewallRuleGroupAssociationId,

    -- * Destructuring the Response
    GetFirewallRuleGroupAssociationResponse (..),
    newGetFirewallRuleGroupAssociationResponse,

    -- * Response Lenses
    getFirewallRuleGroupAssociationResponse_firewallRuleGroupAssociation,
    getFirewallRuleGroupAssociationResponse_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:/ 'newGetFirewallRuleGroupAssociation' smart constructor.
data GetFirewallRuleGroupAssociation = GetFirewallRuleGroupAssociation'
  { -- | The identifier of the FirewallRuleGroupAssociation.
    GetFirewallRuleGroupAssociation -> Text
firewallRuleGroupAssociationId :: Prelude.Text
  }
  deriving (GetFirewallRuleGroupAssociation
-> GetFirewallRuleGroupAssociation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFirewallRuleGroupAssociation
-> GetFirewallRuleGroupAssociation -> Bool
$c/= :: GetFirewallRuleGroupAssociation
-> GetFirewallRuleGroupAssociation -> Bool
== :: GetFirewallRuleGroupAssociation
-> GetFirewallRuleGroupAssociation -> Bool
$c== :: GetFirewallRuleGroupAssociation
-> GetFirewallRuleGroupAssociation -> Bool
Prelude.Eq, ReadPrec [GetFirewallRuleGroupAssociation]
ReadPrec GetFirewallRuleGroupAssociation
Int -> ReadS GetFirewallRuleGroupAssociation
ReadS [GetFirewallRuleGroupAssociation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFirewallRuleGroupAssociation]
$creadListPrec :: ReadPrec [GetFirewallRuleGroupAssociation]
readPrec :: ReadPrec GetFirewallRuleGroupAssociation
$creadPrec :: ReadPrec GetFirewallRuleGroupAssociation
readList :: ReadS [GetFirewallRuleGroupAssociation]
$creadList :: ReadS [GetFirewallRuleGroupAssociation]
readsPrec :: Int -> ReadS GetFirewallRuleGroupAssociation
$creadsPrec :: Int -> ReadS GetFirewallRuleGroupAssociation
Prelude.Read, Int -> GetFirewallRuleGroupAssociation -> ShowS
[GetFirewallRuleGroupAssociation] -> ShowS
GetFirewallRuleGroupAssociation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFirewallRuleGroupAssociation] -> ShowS
$cshowList :: [GetFirewallRuleGroupAssociation] -> ShowS
show :: GetFirewallRuleGroupAssociation -> String
$cshow :: GetFirewallRuleGroupAssociation -> String
showsPrec :: Int -> GetFirewallRuleGroupAssociation -> ShowS
$cshowsPrec :: Int -> GetFirewallRuleGroupAssociation -> ShowS
Prelude.Show, forall x.
Rep GetFirewallRuleGroupAssociation x
-> GetFirewallRuleGroupAssociation
forall x.
GetFirewallRuleGroupAssociation
-> Rep GetFirewallRuleGroupAssociation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetFirewallRuleGroupAssociation x
-> GetFirewallRuleGroupAssociation
$cfrom :: forall x.
GetFirewallRuleGroupAssociation
-> Rep GetFirewallRuleGroupAssociation x
Prelude.Generic)

-- |
-- Create a value of 'GetFirewallRuleGroupAssociation' 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:
--
-- 'firewallRuleGroupAssociationId', 'getFirewallRuleGroupAssociation_firewallRuleGroupAssociationId' - The identifier of the FirewallRuleGroupAssociation.
newGetFirewallRuleGroupAssociation ::
  -- | 'firewallRuleGroupAssociationId'
  Prelude.Text ->
  GetFirewallRuleGroupAssociation
newGetFirewallRuleGroupAssociation :: Text -> GetFirewallRuleGroupAssociation
newGetFirewallRuleGroupAssociation
  Text
pFirewallRuleGroupAssociationId_ =
    GetFirewallRuleGroupAssociation'
      { $sel:firewallRuleGroupAssociationId:GetFirewallRuleGroupAssociation' :: Text
firewallRuleGroupAssociationId =
          Text
pFirewallRuleGroupAssociationId_
      }

-- | The identifier of the FirewallRuleGroupAssociation.
getFirewallRuleGroupAssociation_firewallRuleGroupAssociationId :: Lens.Lens' GetFirewallRuleGroupAssociation Prelude.Text
getFirewallRuleGroupAssociation_firewallRuleGroupAssociationId :: Lens' GetFirewallRuleGroupAssociation Text
getFirewallRuleGroupAssociation_firewallRuleGroupAssociationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFirewallRuleGroupAssociation' {Text
firewallRuleGroupAssociationId :: Text
$sel:firewallRuleGroupAssociationId:GetFirewallRuleGroupAssociation' :: GetFirewallRuleGroupAssociation -> Text
firewallRuleGroupAssociationId} -> Text
firewallRuleGroupAssociationId) (\s :: GetFirewallRuleGroupAssociation
s@GetFirewallRuleGroupAssociation' {} Text
a -> GetFirewallRuleGroupAssociation
s {$sel:firewallRuleGroupAssociationId:GetFirewallRuleGroupAssociation' :: Text
firewallRuleGroupAssociationId = Text
a} :: GetFirewallRuleGroupAssociation)

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

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

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

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

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

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

-- |
-- Create a value of 'GetFirewallRuleGroupAssociationResponse' 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:
--
-- 'firewallRuleGroupAssociation', 'getFirewallRuleGroupAssociationResponse_firewallRuleGroupAssociation' - The association that you requested.
--
-- 'httpStatus', 'getFirewallRuleGroupAssociationResponse_httpStatus' - The response's http status code.
newGetFirewallRuleGroupAssociationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetFirewallRuleGroupAssociationResponse
newGetFirewallRuleGroupAssociationResponse :: Int -> GetFirewallRuleGroupAssociationResponse
newGetFirewallRuleGroupAssociationResponse
  Int
pHttpStatus_ =
    GetFirewallRuleGroupAssociationResponse'
      { $sel:firewallRuleGroupAssociation:GetFirewallRuleGroupAssociationResponse' :: Maybe FirewallRuleGroupAssociation
firewallRuleGroupAssociation =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetFirewallRuleGroupAssociationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The association that you requested.
getFirewallRuleGroupAssociationResponse_firewallRuleGroupAssociation :: Lens.Lens' GetFirewallRuleGroupAssociationResponse (Prelude.Maybe FirewallRuleGroupAssociation)
getFirewallRuleGroupAssociationResponse_firewallRuleGroupAssociation :: Lens'
  GetFirewallRuleGroupAssociationResponse
  (Maybe FirewallRuleGroupAssociation)
getFirewallRuleGroupAssociationResponse_firewallRuleGroupAssociation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFirewallRuleGroupAssociationResponse' {Maybe FirewallRuleGroupAssociation
firewallRuleGroupAssociation :: Maybe FirewallRuleGroupAssociation
$sel:firewallRuleGroupAssociation:GetFirewallRuleGroupAssociationResponse' :: GetFirewallRuleGroupAssociationResponse
-> Maybe FirewallRuleGroupAssociation
firewallRuleGroupAssociation} -> Maybe FirewallRuleGroupAssociation
firewallRuleGroupAssociation) (\s :: GetFirewallRuleGroupAssociationResponse
s@GetFirewallRuleGroupAssociationResponse' {} Maybe FirewallRuleGroupAssociation
a -> GetFirewallRuleGroupAssociationResponse
s {$sel:firewallRuleGroupAssociation:GetFirewallRuleGroupAssociationResponse' :: Maybe FirewallRuleGroupAssociation
firewallRuleGroupAssociation = Maybe FirewallRuleGroupAssociation
a} :: GetFirewallRuleGroupAssociationResponse)

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

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