{-# 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.FMS.ListProtocolsLists
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns an array of @ProtocolsListDataSummary@ objects.
--
-- This operation returns paginated results.
module Amazonka.FMS.ListProtocolsLists
  ( -- * Creating a Request
    ListProtocolsLists (..),
    newListProtocolsLists,

    -- * Request Lenses
    listProtocolsLists_defaultLists,
    listProtocolsLists_nextToken,
    listProtocolsLists_maxResults,

    -- * Destructuring the Response
    ListProtocolsListsResponse (..),
    newListProtocolsListsResponse,

    -- * Response Lenses
    listProtocolsListsResponse_nextToken,
    listProtocolsListsResponse_protocolsLists,
    listProtocolsListsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListProtocolsLists' smart constructor.
data ListProtocolsLists = ListProtocolsLists'
  { -- | Specifies whether the lists to retrieve are default lists owned by
    -- Firewall Manager.
    ListProtocolsLists -> Maybe Bool
defaultLists :: Prelude.Maybe Prelude.Bool,
    -- | If you specify a value for @MaxResults@ in your list request, and you
    -- have more objects than the maximum, Firewall Manager returns this token
    -- in the response. For all but the first request, you provide the token
    -- returned by the prior request in the request parameters, to retrieve the
    -- next batch of objects.
    ListProtocolsLists -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of objects that you want Firewall Manager to return
    -- for this request. If more objects are available, in the response,
    -- Firewall Manager provides a @NextToken@ value that you can use in a
    -- subsequent call to get the next batch of objects.
    --
    -- If you don\'t specify this, Firewall Manager returns all available
    -- objects.
    ListProtocolsLists -> Natural
maxResults :: Prelude.Natural
  }
  deriving (ListProtocolsLists -> ListProtocolsLists -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListProtocolsLists -> ListProtocolsLists -> Bool
$c/= :: ListProtocolsLists -> ListProtocolsLists -> Bool
== :: ListProtocolsLists -> ListProtocolsLists -> Bool
$c== :: ListProtocolsLists -> ListProtocolsLists -> Bool
Prelude.Eq, ReadPrec [ListProtocolsLists]
ReadPrec ListProtocolsLists
Int -> ReadS ListProtocolsLists
ReadS [ListProtocolsLists]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListProtocolsLists]
$creadListPrec :: ReadPrec [ListProtocolsLists]
readPrec :: ReadPrec ListProtocolsLists
$creadPrec :: ReadPrec ListProtocolsLists
readList :: ReadS [ListProtocolsLists]
$creadList :: ReadS [ListProtocolsLists]
readsPrec :: Int -> ReadS ListProtocolsLists
$creadsPrec :: Int -> ReadS ListProtocolsLists
Prelude.Read, Int -> ListProtocolsLists -> ShowS
[ListProtocolsLists] -> ShowS
ListProtocolsLists -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListProtocolsLists] -> ShowS
$cshowList :: [ListProtocolsLists] -> ShowS
show :: ListProtocolsLists -> String
$cshow :: ListProtocolsLists -> String
showsPrec :: Int -> ListProtocolsLists -> ShowS
$cshowsPrec :: Int -> ListProtocolsLists -> ShowS
Prelude.Show, forall x. Rep ListProtocolsLists x -> ListProtocolsLists
forall x. ListProtocolsLists -> Rep ListProtocolsLists x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListProtocolsLists x -> ListProtocolsLists
$cfrom :: forall x. ListProtocolsLists -> Rep ListProtocolsLists x
Prelude.Generic)

-- |
-- Create a value of 'ListProtocolsLists' 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:
--
-- 'defaultLists', 'listProtocolsLists_defaultLists' - Specifies whether the lists to retrieve are default lists owned by
-- Firewall Manager.
--
-- 'nextToken', 'listProtocolsLists_nextToken' - If you specify a value for @MaxResults@ in your list request, and you
-- have more objects than the maximum, Firewall Manager returns this token
-- in the response. For all but the first request, you provide the token
-- returned by the prior request in the request parameters, to retrieve the
-- next batch of objects.
--
-- 'maxResults', 'listProtocolsLists_maxResults' - The maximum number of objects that you want Firewall Manager to return
-- for this request. If more objects are available, in the response,
-- Firewall Manager provides a @NextToken@ value that you can use in a
-- subsequent call to get the next batch of objects.
--
-- If you don\'t specify this, Firewall Manager returns all available
-- objects.
newListProtocolsLists ::
  -- | 'maxResults'
  Prelude.Natural ->
  ListProtocolsLists
newListProtocolsLists :: Natural -> ListProtocolsLists
newListProtocolsLists Natural
pMaxResults_ =
  ListProtocolsLists'
    { $sel:defaultLists:ListProtocolsLists' :: Maybe Bool
defaultLists = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListProtocolsLists' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListProtocolsLists' :: Natural
maxResults = Natural
pMaxResults_
    }

-- | Specifies whether the lists to retrieve are default lists owned by
-- Firewall Manager.
listProtocolsLists_defaultLists :: Lens.Lens' ListProtocolsLists (Prelude.Maybe Prelude.Bool)
listProtocolsLists_defaultLists :: Lens' ListProtocolsLists (Maybe Bool)
listProtocolsLists_defaultLists = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListProtocolsLists' {Maybe Bool
defaultLists :: Maybe Bool
$sel:defaultLists:ListProtocolsLists' :: ListProtocolsLists -> Maybe Bool
defaultLists} -> Maybe Bool
defaultLists) (\s :: ListProtocolsLists
s@ListProtocolsLists' {} Maybe Bool
a -> ListProtocolsLists
s {$sel:defaultLists:ListProtocolsLists' :: Maybe Bool
defaultLists = Maybe Bool
a} :: ListProtocolsLists)

-- | If you specify a value for @MaxResults@ in your list request, and you
-- have more objects than the maximum, Firewall Manager returns this token
-- in the response. For all but the first request, you provide the token
-- returned by the prior request in the request parameters, to retrieve the
-- next batch of objects.
listProtocolsLists_nextToken :: Lens.Lens' ListProtocolsLists (Prelude.Maybe Prelude.Text)
listProtocolsLists_nextToken :: Lens' ListProtocolsLists (Maybe Text)
listProtocolsLists_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListProtocolsLists' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListProtocolsLists' :: ListProtocolsLists -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListProtocolsLists
s@ListProtocolsLists' {} Maybe Text
a -> ListProtocolsLists
s {$sel:nextToken:ListProtocolsLists' :: Maybe Text
nextToken = Maybe Text
a} :: ListProtocolsLists)

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

instance Core.AWSPager ListProtocolsLists where
  page :: ListProtocolsLists
-> AWSResponse ListProtocolsLists -> Maybe ListProtocolsLists
page ListProtocolsLists
rq AWSResponse ListProtocolsLists
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListProtocolsLists
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListProtocolsListsResponse (Maybe Text)
listProtocolsListsResponse_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 ListProtocolsLists
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListProtocolsListsResponse (Maybe [ProtocolsListDataSummary])
listProtocolsListsResponse_protocolsLists
            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.$ ListProtocolsLists
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListProtocolsLists (Maybe Text)
listProtocolsLists_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListProtocolsLists
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListProtocolsListsResponse (Maybe Text)
listProtocolsListsResponse_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 ListProtocolsLists where
  type
    AWSResponse ListProtocolsLists =
      ListProtocolsListsResponse
  request :: (Service -> Service)
-> ListProtocolsLists -> Request ListProtocolsLists
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 ListProtocolsLists
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListProtocolsLists)))
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 Text
-> Maybe [ProtocolsListDataSummary]
-> Int
-> ListProtocolsListsResponse
ListProtocolsListsResponse'
            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
"NextToken")
            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
"ProtocolsLists" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListProtocolsLists where
  hashWithSalt :: Int -> ListProtocolsLists -> Int
hashWithSalt Int
_salt ListProtocolsLists' {Natural
Maybe Bool
Maybe Text
maxResults :: Natural
nextToken :: Maybe Text
defaultLists :: Maybe Bool
$sel:maxResults:ListProtocolsLists' :: ListProtocolsLists -> Natural
$sel:nextToken:ListProtocolsLists' :: ListProtocolsLists -> Maybe Text
$sel:defaultLists:ListProtocolsLists' :: ListProtocolsLists -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
defaultLists
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
maxResults

instance Prelude.NFData ListProtocolsLists where
  rnf :: ListProtocolsLists -> ()
rnf ListProtocolsLists' {Natural
Maybe Bool
Maybe Text
maxResults :: Natural
nextToken :: Maybe Text
defaultLists :: Maybe Bool
$sel:maxResults:ListProtocolsLists' :: ListProtocolsLists -> Natural
$sel:nextToken:ListProtocolsLists' :: ListProtocolsLists -> Maybe Text
$sel:defaultLists:ListProtocolsLists' :: ListProtocolsLists -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
defaultLists
      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 Natural
maxResults

instance Data.ToHeaders ListProtocolsLists where
  toHeaders :: ListProtocolsLists -> 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
"AWSFMS_20180101.ListProtocolsLists" ::
                          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 ListProtocolsLists where
  toJSON :: ListProtocolsLists -> Value
toJSON ListProtocolsLists' {Natural
Maybe Bool
Maybe Text
maxResults :: Natural
nextToken :: Maybe Text
defaultLists :: Maybe Bool
$sel:maxResults:ListProtocolsLists' :: ListProtocolsLists -> Natural
$sel:nextToken:ListProtocolsLists' :: ListProtocolsLists -> Maybe Text
$sel:defaultLists:ListProtocolsLists' :: ListProtocolsLists -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DefaultLists" 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 Bool
defaultLists,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"MaxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
maxResults)
          ]
      )

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

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

-- | /See:/ 'newListProtocolsListsResponse' smart constructor.
data ListProtocolsListsResponse = ListProtocolsListsResponse'
  { -- | If you specify a value for @MaxResults@ in your list request, and you
    -- have more objects than the maximum, Firewall Manager returns this token
    -- in the response. You can use this token in subsequent requests to
    -- retrieve the next batch of objects.
    ListProtocolsListsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | An array of @ProtocolsListDataSummary@ objects.
    ListProtocolsListsResponse -> Maybe [ProtocolsListDataSummary]
protocolsLists :: Prelude.Maybe [ProtocolsListDataSummary],
    -- | The response's http status code.
    ListProtocolsListsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListProtocolsListsResponse -> ListProtocolsListsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListProtocolsListsResponse -> ListProtocolsListsResponse -> Bool
$c/= :: ListProtocolsListsResponse -> ListProtocolsListsResponse -> Bool
== :: ListProtocolsListsResponse -> ListProtocolsListsResponse -> Bool
$c== :: ListProtocolsListsResponse -> ListProtocolsListsResponse -> Bool
Prelude.Eq, ReadPrec [ListProtocolsListsResponse]
ReadPrec ListProtocolsListsResponse
Int -> ReadS ListProtocolsListsResponse
ReadS [ListProtocolsListsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListProtocolsListsResponse]
$creadListPrec :: ReadPrec [ListProtocolsListsResponse]
readPrec :: ReadPrec ListProtocolsListsResponse
$creadPrec :: ReadPrec ListProtocolsListsResponse
readList :: ReadS [ListProtocolsListsResponse]
$creadList :: ReadS [ListProtocolsListsResponse]
readsPrec :: Int -> ReadS ListProtocolsListsResponse
$creadsPrec :: Int -> ReadS ListProtocolsListsResponse
Prelude.Read, Int -> ListProtocolsListsResponse -> ShowS
[ListProtocolsListsResponse] -> ShowS
ListProtocolsListsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListProtocolsListsResponse] -> ShowS
$cshowList :: [ListProtocolsListsResponse] -> ShowS
show :: ListProtocolsListsResponse -> String
$cshow :: ListProtocolsListsResponse -> String
showsPrec :: Int -> ListProtocolsListsResponse -> ShowS
$cshowsPrec :: Int -> ListProtocolsListsResponse -> ShowS
Prelude.Show, forall x.
Rep ListProtocolsListsResponse x -> ListProtocolsListsResponse
forall x.
ListProtocolsListsResponse -> Rep ListProtocolsListsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListProtocolsListsResponse x -> ListProtocolsListsResponse
$cfrom :: forall x.
ListProtocolsListsResponse -> Rep ListProtocolsListsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListProtocolsListsResponse' 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:
--
-- 'nextToken', 'listProtocolsListsResponse_nextToken' - If you specify a value for @MaxResults@ in your list request, and you
-- have more objects than the maximum, Firewall Manager returns this token
-- in the response. You can use this token in subsequent requests to
-- retrieve the next batch of objects.
--
-- 'protocolsLists', 'listProtocolsListsResponse_protocolsLists' - An array of @ProtocolsListDataSummary@ objects.
--
-- 'httpStatus', 'listProtocolsListsResponse_httpStatus' - The response's http status code.
newListProtocolsListsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListProtocolsListsResponse
newListProtocolsListsResponse :: Int -> ListProtocolsListsResponse
newListProtocolsListsResponse Int
pHttpStatus_ =
  ListProtocolsListsResponse'
    { $sel:nextToken:ListProtocolsListsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:protocolsLists:ListProtocolsListsResponse' :: Maybe [ProtocolsListDataSummary]
protocolsLists = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListProtocolsListsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If you specify a value for @MaxResults@ in your list request, and you
-- have more objects than the maximum, Firewall Manager returns this token
-- in the response. You can use this token in subsequent requests to
-- retrieve the next batch of objects.
listProtocolsListsResponse_nextToken :: Lens.Lens' ListProtocolsListsResponse (Prelude.Maybe Prelude.Text)
listProtocolsListsResponse_nextToken :: Lens' ListProtocolsListsResponse (Maybe Text)
listProtocolsListsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListProtocolsListsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListProtocolsListsResponse' :: ListProtocolsListsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListProtocolsListsResponse
s@ListProtocolsListsResponse' {} Maybe Text
a -> ListProtocolsListsResponse
s {$sel:nextToken:ListProtocolsListsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListProtocolsListsResponse)

-- | An array of @ProtocolsListDataSummary@ objects.
listProtocolsListsResponse_protocolsLists :: Lens.Lens' ListProtocolsListsResponse (Prelude.Maybe [ProtocolsListDataSummary])
listProtocolsListsResponse_protocolsLists :: Lens' ListProtocolsListsResponse (Maybe [ProtocolsListDataSummary])
listProtocolsListsResponse_protocolsLists = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListProtocolsListsResponse' {Maybe [ProtocolsListDataSummary]
protocolsLists :: Maybe [ProtocolsListDataSummary]
$sel:protocolsLists:ListProtocolsListsResponse' :: ListProtocolsListsResponse -> Maybe [ProtocolsListDataSummary]
protocolsLists} -> Maybe [ProtocolsListDataSummary]
protocolsLists) (\s :: ListProtocolsListsResponse
s@ListProtocolsListsResponse' {} Maybe [ProtocolsListDataSummary]
a -> ListProtocolsListsResponse
s {$sel:protocolsLists:ListProtocolsListsResponse' :: Maybe [ProtocolsListDataSummary]
protocolsLists = Maybe [ProtocolsListDataSummary]
a} :: ListProtocolsListsResponse) 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

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

instance Prelude.NFData ListProtocolsListsResponse where
  rnf :: ListProtocolsListsResponse -> ()
rnf ListProtocolsListsResponse' {Int
Maybe [ProtocolsListDataSummary]
Maybe Text
httpStatus :: Int
protocolsLists :: Maybe [ProtocolsListDataSummary]
nextToken :: Maybe Text
$sel:httpStatus:ListProtocolsListsResponse' :: ListProtocolsListsResponse -> Int
$sel:protocolsLists:ListProtocolsListsResponse' :: ListProtocolsListsResponse -> Maybe [ProtocolsListDataSummary]
$sel:nextToken:ListProtocolsListsResponse' :: ListProtocolsListsResponse -> Maybe Text
..} =
    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 [ProtocolsListDataSummary]
protocolsLists
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus