{-# 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.ListFirewallRules
-- 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 the firewall rules that you have defined for the specified
-- firewall rule group. DNS Firewall uses the rules in a rule group to
-- filter DNS network traffic for a VPC.
--
-- A single call might return only a partial list of the rules. For
-- information, see @MaxResults@.
--
-- This operation returns paginated results.
module Amazonka.Route53Resolver.ListFirewallRules
  ( -- * Creating a Request
    ListFirewallRules (..),
    newListFirewallRules,

    -- * Request Lenses
    listFirewallRules_action,
    listFirewallRules_maxResults,
    listFirewallRules_nextToken,
    listFirewallRules_priority,
    listFirewallRules_firewallRuleGroupId,

    -- * Destructuring the Response
    ListFirewallRulesResponse (..),
    newListFirewallRulesResponse,

    -- * Response Lenses
    listFirewallRulesResponse_firewallRules,
    listFirewallRulesResponse_nextToken,
    listFirewallRulesResponse_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:/ 'newListFirewallRules' smart constructor.
data ListFirewallRules = ListFirewallRules'
  { -- | Optional additional filter for the rules to retrieve.
    --
    -- The action that DNS Firewall should take on a DNS query when it matches
    -- one of the domains in the rule\'s domain list:
    --
    -- -   @ALLOW@ - Permit the request to go through.
    --
    -- -   @ALERT@ - Permit the request to go through but send an alert to the
    --     logs.
    --
    -- -   @BLOCK@ - Disallow the request. If this is specified, additional
    --     handling details are provided in the rule\'s @BlockResponse@
    --     setting.
    ListFirewallRules -> Maybe Action
action :: Prelude.Maybe Action,
    -- | The maximum number of objects that you want Resolver to return for this
    -- request. If more objects are available, in the response, Resolver
    -- provides a @NextToken@ value that you can use in a subsequent call to
    -- get the next batch of objects.
    --
    -- If you don\'t specify a value for @MaxResults@, Resolver returns up to
    -- 100 objects.
    ListFirewallRules -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | For the first call to this list request, omit this value.
    --
    -- When you request a list of objects, Resolver returns at most the number
    -- of objects specified in @MaxResults@. If more objects are available for
    -- retrieval, Resolver returns a @NextToken@ value in the response. To
    -- retrieve the next batch of objects, use the token that was returned for
    -- the prior request in your next request.
    ListFirewallRules -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Optional additional filter for the rules to retrieve.
    --
    -- The setting that determines the processing order of the rules in a rule
    -- group. DNS Firewall processes the rules in a rule group by order of
    -- priority, starting from the lowest setting.
    ListFirewallRules -> Maybe Int
priority :: Prelude.Maybe Prelude.Int,
    -- | The unique identifier of the firewall rule group that you want to
    -- retrieve the rules for.
    ListFirewallRules -> Text
firewallRuleGroupId :: Prelude.Text
  }
  deriving (ListFirewallRules -> ListFirewallRules -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFirewallRules -> ListFirewallRules -> Bool
$c/= :: ListFirewallRules -> ListFirewallRules -> Bool
== :: ListFirewallRules -> ListFirewallRules -> Bool
$c== :: ListFirewallRules -> ListFirewallRules -> Bool
Prelude.Eq, ReadPrec [ListFirewallRules]
ReadPrec ListFirewallRules
Int -> ReadS ListFirewallRules
ReadS [ListFirewallRules]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFirewallRules]
$creadListPrec :: ReadPrec [ListFirewallRules]
readPrec :: ReadPrec ListFirewallRules
$creadPrec :: ReadPrec ListFirewallRules
readList :: ReadS [ListFirewallRules]
$creadList :: ReadS [ListFirewallRules]
readsPrec :: Int -> ReadS ListFirewallRules
$creadsPrec :: Int -> ReadS ListFirewallRules
Prelude.Read, Int -> ListFirewallRules -> ShowS
[ListFirewallRules] -> ShowS
ListFirewallRules -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFirewallRules] -> ShowS
$cshowList :: [ListFirewallRules] -> ShowS
show :: ListFirewallRules -> String
$cshow :: ListFirewallRules -> String
showsPrec :: Int -> ListFirewallRules -> ShowS
$cshowsPrec :: Int -> ListFirewallRules -> ShowS
Prelude.Show, forall x. Rep ListFirewallRules x -> ListFirewallRules
forall x. ListFirewallRules -> Rep ListFirewallRules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListFirewallRules x -> ListFirewallRules
$cfrom :: forall x. ListFirewallRules -> Rep ListFirewallRules x
Prelude.Generic)

-- |
-- Create a value of 'ListFirewallRules' 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:
--
-- 'action', 'listFirewallRules_action' - Optional additional filter for the rules to retrieve.
--
-- The action that DNS Firewall should take on a DNS query when it matches
-- one of the domains in the rule\'s domain list:
--
-- -   @ALLOW@ - Permit the request to go through.
--
-- -   @ALERT@ - Permit the request to go through but send an alert to the
--     logs.
--
-- -   @BLOCK@ - Disallow the request. If this is specified, additional
--     handling details are provided in the rule\'s @BlockResponse@
--     setting.
--
-- 'maxResults', 'listFirewallRules_maxResults' - The maximum number of objects that you want Resolver to return for this
-- request. If more objects are available, in the response, Resolver
-- provides a @NextToken@ value that you can use in a subsequent call to
-- get the next batch of objects.
--
-- If you don\'t specify a value for @MaxResults@, Resolver returns up to
-- 100 objects.
--
-- 'nextToken', 'listFirewallRules_nextToken' - For the first call to this list request, omit this value.
--
-- When you request a list of objects, Resolver returns at most the number
-- of objects specified in @MaxResults@. If more objects are available for
-- retrieval, Resolver returns a @NextToken@ value in the response. To
-- retrieve the next batch of objects, use the token that was returned for
-- the prior request in your next request.
--
-- 'priority', 'listFirewallRules_priority' - Optional additional filter for the rules to retrieve.
--
-- The setting that determines the processing order of the rules in a rule
-- group. DNS Firewall processes the rules in a rule group by order of
-- priority, starting from the lowest setting.
--
-- 'firewallRuleGroupId', 'listFirewallRules_firewallRuleGroupId' - The unique identifier of the firewall rule group that you want to
-- retrieve the rules for.
newListFirewallRules ::
  -- | 'firewallRuleGroupId'
  Prelude.Text ->
  ListFirewallRules
newListFirewallRules :: Text -> ListFirewallRules
newListFirewallRules Text
pFirewallRuleGroupId_ =
  ListFirewallRules'
    { $sel:action:ListFirewallRules' :: Maybe Action
action = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListFirewallRules' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListFirewallRules' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:priority:ListFirewallRules' :: Maybe Int
priority = forall a. Maybe a
Prelude.Nothing,
      $sel:firewallRuleGroupId:ListFirewallRules' :: Text
firewallRuleGroupId = Text
pFirewallRuleGroupId_
    }

-- | Optional additional filter for the rules to retrieve.
--
-- The action that DNS Firewall should take on a DNS query when it matches
-- one of the domains in the rule\'s domain list:
--
-- -   @ALLOW@ - Permit the request to go through.
--
-- -   @ALERT@ - Permit the request to go through but send an alert to the
--     logs.
--
-- -   @BLOCK@ - Disallow the request. If this is specified, additional
--     handling details are provided in the rule\'s @BlockResponse@
--     setting.
listFirewallRules_action :: Lens.Lens' ListFirewallRules (Prelude.Maybe Action)
listFirewallRules_action :: Lens' ListFirewallRules (Maybe Action)
listFirewallRules_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFirewallRules' {Maybe Action
action :: Maybe Action
$sel:action:ListFirewallRules' :: ListFirewallRules -> Maybe Action
action} -> Maybe Action
action) (\s :: ListFirewallRules
s@ListFirewallRules' {} Maybe Action
a -> ListFirewallRules
s {$sel:action:ListFirewallRules' :: Maybe Action
action = Maybe Action
a} :: ListFirewallRules)

-- | The maximum number of objects that you want Resolver to return for this
-- request. If more objects are available, in the response, Resolver
-- provides a @NextToken@ value that you can use in a subsequent call to
-- get the next batch of objects.
--
-- If you don\'t specify a value for @MaxResults@, Resolver returns up to
-- 100 objects.
listFirewallRules_maxResults :: Lens.Lens' ListFirewallRules (Prelude.Maybe Prelude.Natural)
listFirewallRules_maxResults :: Lens' ListFirewallRules (Maybe Natural)
listFirewallRules_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFirewallRules' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListFirewallRules' :: ListFirewallRules -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListFirewallRules
s@ListFirewallRules' {} Maybe Natural
a -> ListFirewallRules
s {$sel:maxResults:ListFirewallRules' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListFirewallRules)

-- | For the first call to this list request, omit this value.
--
-- When you request a list of objects, Resolver returns at most the number
-- of objects specified in @MaxResults@. If more objects are available for
-- retrieval, Resolver returns a @NextToken@ value in the response. To
-- retrieve the next batch of objects, use the token that was returned for
-- the prior request in your next request.
listFirewallRules_nextToken :: Lens.Lens' ListFirewallRules (Prelude.Maybe Prelude.Text)
listFirewallRules_nextToken :: Lens' ListFirewallRules (Maybe Text)
listFirewallRules_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFirewallRules' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFirewallRules' :: ListFirewallRules -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFirewallRules
s@ListFirewallRules' {} Maybe Text
a -> ListFirewallRules
s {$sel:nextToken:ListFirewallRules' :: Maybe Text
nextToken = Maybe Text
a} :: ListFirewallRules)

-- | Optional additional filter for the rules to retrieve.
--
-- The setting that determines the processing order of the rules in a rule
-- group. DNS Firewall processes the rules in a rule group by order of
-- priority, starting from the lowest setting.
listFirewallRules_priority :: Lens.Lens' ListFirewallRules (Prelude.Maybe Prelude.Int)
listFirewallRules_priority :: Lens' ListFirewallRules (Maybe Int)
listFirewallRules_priority = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFirewallRules' {Maybe Int
priority :: Maybe Int
$sel:priority:ListFirewallRules' :: ListFirewallRules -> Maybe Int
priority} -> Maybe Int
priority) (\s :: ListFirewallRules
s@ListFirewallRules' {} Maybe Int
a -> ListFirewallRules
s {$sel:priority:ListFirewallRules' :: Maybe Int
priority = Maybe Int
a} :: ListFirewallRules)

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

instance Core.AWSPager ListFirewallRules where
  page :: ListFirewallRules
-> AWSResponse ListFirewallRules -> Maybe ListFirewallRules
page ListFirewallRules
rq AWSResponse ListFirewallRules
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListFirewallRules
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListFirewallRulesResponse (Maybe Text)
listFirewallRulesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListFirewallRules
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListFirewallRulesResponse (Maybe [FirewallRule])
listFirewallRulesResponse_firewallRules
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListFirewallRules
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListFirewallRules (Maybe Text)
listFirewallRules_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListFirewallRules
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListFirewallRulesResponse (Maybe Text)
listFirewallRulesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListFirewallRules where
  type
    AWSResponse ListFirewallRules =
      ListFirewallRulesResponse
  request :: (Service -> Service)
-> ListFirewallRules -> Request ListFirewallRules
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 ListFirewallRules
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListFirewallRules)))
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 [FirewallRule]
-> Maybe Text -> Int -> ListFirewallRulesResponse
ListFirewallRulesResponse'
            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
"FirewallRules" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NextToken")
            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 ListFirewallRules where
  hashWithSalt :: Int -> ListFirewallRules -> Int
hashWithSalt Int
_salt ListFirewallRules' {Maybe Int
Maybe Natural
Maybe Text
Maybe Action
Text
firewallRuleGroupId :: Text
priority :: Maybe Int
nextToken :: Maybe Text
maxResults :: Maybe Natural
action :: Maybe Action
$sel:firewallRuleGroupId:ListFirewallRules' :: ListFirewallRules -> Text
$sel:priority:ListFirewallRules' :: ListFirewallRules -> Maybe Int
$sel:nextToken:ListFirewallRules' :: ListFirewallRules -> Maybe Text
$sel:maxResults:ListFirewallRules' :: ListFirewallRules -> Maybe Natural
$sel:action:ListFirewallRules' :: ListFirewallRules -> Maybe Action
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Action
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
priority
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
firewallRuleGroupId

instance Prelude.NFData ListFirewallRules where
  rnf :: ListFirewallRules -> ()
rnf ListFirewallRules' {Maybe Int
Maybe Natural
Maybe Text
Maybe Action
Text
firewallRuleGroupId :: Text
priority :: Maybe Int
nextToken :: Maybe Text
maxResults :: Maybe Natural
action :: Maybe Action
$sel:firewallRuleGroupId:ListFirewallRules' :: ListFirewallRules -> Text
$sel:priority:ListFirewallRules' :: ListFirewallRules -> Maybe Int
$sel:nextToken:ListFirewallRules' :: ListFirewallRules -> Maybe Text
$sel:maxResults:ListFirewallRules' :: ListFirewallRules -> Maybe Natural
$sel:action:ListFirewallRules' :: ListFirewallRules -> Maybe Action
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Action
action
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
priority
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
firewallRuleGroupId

instance Data.ToHeaders ListFirewallRules where
  toHeaders :: ListFirewallRules -> 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.ListFirewallRules" ::
                          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 ListFirewallRules where
  toJSON :: ListFirewallRules -> Value
toJSON ListFirewallRules' {Maybe Int
Maybe Natural
Maybe Text
Maybe Action
Text
firewallRuleGroupId :: Text
priority :: Maybe Int
nextToken :: Maybe Text
maxResults :: Maybe Natural
action :: Maybe Action
$sel:firewallRuleGroupId:ListFirewallRules' :: ListFirewallRules -> Text
$sel:priority:ListFirewallRules' :: ListFirewallRules -> Maybe Int
$sel:nextToken:ListFirewallRules' :: ListFirewallRules -> Maybe Text
$sel:maxResults:ListFirewallRules' :: ListFirewallRules -> Maybe Natural
$sel:action:ListFirewallRules' :: ListFirewallRules -> Maybe Action
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Action" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Action
action,
            (Key
"MaxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
maxResults,
            (Key
"NextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken,
            (Key
"Priority" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Int
priority,
            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 ListFirewallRules where
  toPath :: ListFirewallRules -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newListFirewallRulesResponse' smart constructor.
data ListFirewallRulesResponse = ListFirewallRulesResponse'
  { -- | A list of the rules that you have defined.
    --
    -- This might be a partial list of the firewall rules that you\'ve defined.
    -- For information, see @MaxResults@.
    ListFirewallRulesResponse -> Maybe [FirewallRule]
firewallRules :: Prelude.Maybe [FirewallRule],
    -- | If objects are still available for retrieval, Resolver returns this
    -- token in the response. To retrieve the next batch of objects, provide
    -- this token in your next request.
    ListFirewallRulesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListFirewallRulesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListFirewallRulesResponse -> ListFirewallRulesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFirewallRulesResponse -> ListFirewallRulesResponse -> Bool
$c/= :: ListFirewallRulesResponse -> ListFirewallRulesResponse -> Bool
== :: ListFirewallRulesResponse -> ListFirewallRulesResponse -> Bool
$c== :: ListFirewallRulesResponse -> ListFirewallRulesResponse -> Bool
Prelude.Eq, ReadPrec [ListFirewallRulesResponse]
ReadPrec ListFirewallRulesResponse
Int -> ReadS ListFirewallRulesResponse
ReadS [ListFirewallRulesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFirewallRulesResponse]
$creadListPrec :: ReadPrec [ListFirewallRulesResponse]
readPrec :: ReadPrec ListFirewallRulesResponse
$creadPrec :: ReadPrec ListFirewallRulesResponse
readList :: ReadS [ListFirewallRulesResponse]
$creadList :: ReadS [ListFirewallRulesResponse]
readsPrec :: Int -> ReadS ListFirewallRulesResponse
$creadsPrec :: Int -> ReadS ListFirewallRulesResponse
Prelude.Read, Int -> ListFirewallRulesResponse -> ShowS
[ListFirewallRulesResponse] -> ShowS
ListFirewallRulesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFirewallRulesResponse] -> ShowS
$cshowList :: [ListFirewallRulesResponse] -> ShowS
show :: ListFirewallRulesResponse -> String
$cshow :: ListFirewallRulesResponse -> String
showsPrec :: Int -> ListFirewallRulesResponse -> ShowS
$cshowsPrec :: Int -> ListFirewallRulesResponse -> ShowS
Prelude.Show, forall x.
Rep ListFirewallRulesResponse x -> ListFirewallRulesResponse
forall x.
ListFirewallRulesResponse -> Rep ListFirewallRulesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListFirewallRulesResponse x -> ListFirewallRulesResponse
$cfrom :: forall x.
ListFirewallRulesResponse -> Rep ListFirewallRulesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListFirewallRulesResponse' 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:
--
-- 'firewallRules', 'listFirewallRulesResponse_firewallRules' - A list of the rules that you have defined.
--
-- This might be a partial list of the firewall rules that you\'ve defined.
-- For information, see @MaxResults@.
--
-- 'nextToken', 'listFirewallRulesResponse_nextToken' - If objects are still available for retrieval, Resolver returns this
-- token in the response. To retrieve the next batch of objects, provide
-- this token in your next request.
--
-- 'httpStatus', 'listFirewallRulesResponse_httpStatus' - The response's http status code.
newListFirewallRulesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListFirewallRulesResponse
newListFirewallRulesResponse :: Int -> ListFirewallRulesResponse
newListFirewallRulesResponse Int
pHttpStatus_ =
  ListFirewallRulesResponse'
    { $sel:firewallRules:ListFirewallRulesResponse' :: Maybe [FirewallRule]
firewallRules =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListFirewallRulesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListFirewallRulesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of the rules that you have defined.
--
-- This might be a partial list of the firewall rules that you\'ve defined.
-- For information, see @MaxResults@.
listFirewallRulesResponse_firewallRules :: Lens.Lens' ListFirewallRulesResponse (Prelude.Maybe [FirewallRule])
listFirewallRulesResponse_firewallRules :: Lens' ListFirewallRulesResponse (Maybe [FirewallRule])
listFirewallRulesResponse_firewallRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFirewallRulesResponse' {Maybe [FirewallRule]
firewallRules :: Maybe [FirewallRule]
$sel:firewallRules:ListFirewallRulesResponse' :: ListFirewallRulesResponse -> Maybe [FirewallRule]
firewallRules} -> Maybe [FirewallRule]
firewallRules) (\s :: ListFirewallRulesResponse
s@ListFirewallRulesResponse' {} Maybe [FirewallRule]
a -> ListFirewallRulesResponse
s {$sel:firewallRules:ListFirewallRulesResponse' :: Maybe [FirewallRule]
firewallRules = Maybe [FirewallRule]
a} :: ListFirewallRulesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | If objects are still available for retrieval, Resolver returns this
-- token in the response. To retrieve the next batch of objects, provide
-- this token in your next request.
listFirewallRulesResponse_nextToken :: Lens.Lens' ListFirewallRulesResponse (Prelude.Maybe Prelude.Text)
listFirewallRulesResponse_nextToken :: Lens' ListFirewallRulesResponse (Maybe Text)
listFirewallRulesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFirewallRulesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFirewallRulesResponse' :: ListFirewallRulesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFirewallRulesResponse
s@ListFirewallRulesResponse' {} Maybe Text
a -> ListFirewallRulesResponse
s {$sel:nextToken:ListFirewallRulesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListFirewallRulesResponse)

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

instance Prelude.NFData ListFirewallRulesResponse where
  rnf :: ListFirewallRulesResponse -> ()
rnf ListFirewallRulesResponse' {Int
Maybe [FirewallRule]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
firewallRules :: Maybe [FirewallRule]
$sel:httpStatus:ListFirewallRulesResponse' :: ListFirewallRulesResponse -> Int
$sel:nextToken:ListFirewallRulesResponse' :: ListFirewallRulesResponse -> Maybe Text
$sel:firewallRules:ListFirewallRulesResponse' :: ListFirewallRulesResponse -> Maybe [FirewallRule]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [FirewallRule]
firewallRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus