{-# 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.LexV2Models.ListBots
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets a list of available bots.
module Amazonka.LexV2Models.ListBots
  ( -- * Creating a Request
    ListBots (..),
    newListBots,

    -- * Request Lenses
    listBots_filters,
    listBots_maxResults,
    listBots_nextToken,
    listBots_sortBy,

    -- * Destructuring the Response
    ListBotsResponse (..),
    newListBotsResponse,

    -- * Response Lenses
    listBotsResponse_botSummaries,
    listBotsResponse_nextToken,
    listBotsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListBots' smart constructor.
data ListBots = ListBots'
  { -- | Provides the specification of a filter used to limit the bots in the
    -- response to only those that match the filter specification. You can only
    -- specify one filter and one string to filter on.
    ListBots -> Maybe (NonEmpty BotFilter)
filters :: Prelude.Maybe (Prelude.NonEmpty BotFilter),
    -- | The maximum number of bots to return in each page of results. If there
    -- are fewer results than the maximum page size, only the actual number of
    -- results are returned.
    ListBots -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If the response from the @ListBots@ operation contains more results than
    -- specified in the @maxResults@ parameter, a token is returned in the
    -- response.
    --
    -- Use the returned token in the @nextToken@ parameter of a @ListBots@
    -- request to return the next page of results. For a complete set of
    -- results, call the @ListBots@ operation until the @nextToken@ returned in
    -- the response is null.
    ListBots -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Specifies sorting parameters for the list of bots. You can specify that
    -- the list be sorted by bot name in ascending or descending order.
    ListBots -> Maybe BotSortBy
sortBy :: Prelude.Maybe BotSortBy
  }
  deriving (ListBots -> ListBots -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBots -> ListBots -> Bool
$c/= :: ListBots -> ListBots -> Bool
== :: ListBots -> ListBots -> Bool
$c== :: ListBots -> ListBots -> Bool
Prelude.Eq, ReadPrec [ListBots]
ReadPrec ListBots
Int -> ReadS ListBots
ReadS [ListBots]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBots]
$creadListPrec :: ReadPrec [ListBots]
readPrec :: ReadPrec ListBots
$creadPrec :: ReadPrec ListBots
readList :: ReadS [ListBots]
$creadList :: ReadS [ListBots]
readsPrec :: Int -> ReadS ListBots
$creadsPrec :: Int -> ReadS ListBots
Prelude.Read, Int -> ListBots -> ShowS
[ListBots] -> ShowS
ListBots -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBots] -> ShowS
$cshowList :: [ListBots] -> ShowS
show :: ListBots -> String
$cshow :: ListBots -> String
showsPrec :: Int -> ListBots -> ShowS
$cshowsPrec :: Int -> ListBots -> ShowS
Prelude.Show, forall x. Rep ListBots x -> ListBots
forall x. ListBots -> Rep ListBots x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBots x -> ListBots
$cfrom :: forall x. ListBots -> Rep ListBots x
Prelude.Generic)

-- |
-- Create a value of 'ListBots' 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:
--
-- 'filters', 'listBots_filters' - Provides the specification of a filter used to limit the bots in the
-- response to only those that match the filter specification. You can only
-- specify one filter and one string to filter on.
--
-- 'maxResults', 'listBots_maxResults' - The maximum number of bots to return in each page of results. If there
-- are fewer results than the maximum page size, only the actual number of
-- results are returned.
--
-- 'nextToken', 'listBots_nextToken' - If the response from the @ListBots@ operation contains more results than
-- specified in the @maxResults@ parameter, a token is returned in the
-- response.
--
-- Use the returned token in the @nextToken@ parameter of a @ListBots@
-- request to return the next page of results. For a complete set of
-- results, call the @ListBots@ operation until the @nextToken@ returned in
-- the response is null.
--
-- 'sortBy', 'listBots_sortBy' - Specifies sorting parameters for the list of bots. You can specify that
-- the list be sorted by bot name in ascending or descending order.
newListBots ::
  ListBots
newListBots :: ListBots
newListBots =
  ListBots'
    { $sel:filters:ListBots' :: Maybe (NonEmpty BotFilter)
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListBots' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBots' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:ListBots' :: Maybe BotSortBy
sortBy = forall a. Maybe a
Prelude.Nothing
    }

-- | Provides the specification of a filter used to limit the bots in the
-- response to only those that match the filter specification. You can only
-- specify one filter and one string to filter on.
listBots_filters :: Lens.Lens' ListBots (Prelude.Maybe (Prelude.NonEmpty BotFilter))
listBots_filters :: Lens' ListBots (Maybe (NonEmpty BotFilter))
listBots_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBots' {Maybe (NonEmpty BotFilter)
filters :: Maybe (NonEmpty BotFilter)
$sel:filters:ListBots' :: ListBots -> Maybe (NonEmpty BotFilter)
filters} -> Maybe (NonEmpty BotFilter)
filters) (\s :: ListBots
s@ListBots' {} Maybe (NonEmpty BotFilter)
a -> ListBots
s {$sel:filters:ListBots' :: Maybe (NonEmpty BotFilter)
filters = Maybe (NonEmpty BotFilter)
a} :: ListBots) 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 maximum number of bots to return in each page of results. If there
-- are fewer results than the maximum page size, only the actual number of
-- results are returned.
listBots_maxResults :: Lens.Lens' ListBots (Prelude.Maybe Prelude.Natural)
listBots_maxResults :: Lens' ListBots (Maybe Natural)
listBots_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBots' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListBots' :: ListBots -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListBots
s@ListBots' {} Maybe Natural
a -> ListBots
s {$sel:maxResults:ListBots' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListBots)

-- | If the response from the @ListBots@ operation contains more results than
-- specified in the @maxResults@ parameter, a token is returned in the
-- response.
--
-- Use the returned token in the @nextToken@ parameter of a @ListBots@
-- request to return the next page of results. For a complete set of
-- results, call the @ListBots@ operation until the @nextToken@ returned in
-- the response is null.
listBots_nextToken :: Lens.Lens' ListBots (Prelude.Maybe Prelude.Text)
listBots_nextToken :: Lens' ListBots (Maybe Text)
listBots_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBots' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBots' :: ListBots -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBots
s@ListBots' {} Maybe Text
a -> ListBots
s {$sel:nextToken:ListBots' :: Maybe Text
nextToken = Maybe Text
a} :: ListBots)

-- | Specifies sorting parameters for the list of bots. You can specify that
-- the list be sorted by bot name in ascending or descending order.
listBots_sortBy :: Lens.Lens' ListBots (Prelude.Maybe BotSortBy)
listBots_sortBy :: Lens' ListBots (Maybe BotSortBy)
listBots_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBots' {Maybe BotSortBy
sortBy :: Maybe BotSortBy
$sel:sortBy:ListBots' :: ListBots -> Maybe BotSortBy
sortBy} -> Maybe BotSortBy
sortBy) (\s :: ListBots
s@ListBots' {} Maybe BotSortBy
a -> ListBots
s {$sel:sortBy:ListBots' :: Maybe BotSortBy
sortBy = Maybe BotSortBy
a} :: ListBots)

instance Core.AWSRequest ListBots where
  type AWSResponse ListBots = ListBotsResponse
  request :: (Service -> Service) -> ListBots -> Request ListBots
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 ListBots
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListBots)))
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 [BotSummary] -> Maybe Text -> Int -> ListBotsResponse
ListBotsResponse'
            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
"botSummaries" 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 ListBots where
  hashWithSalt :: Int -> ListBots -> Int
hashWithSalt Int
_salt ListBots' {Maybe Natural
Maybe (NonEmpty BotFilter)
Maybe Text
Maybe BotSortBy
sortBy :: Maybe BotSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (NonEmpty BotFilter)
$sel:sortBy:ListBots' :: ListBots -> Maybe BotSortBy
$sel:nextToken:ListBots' :: ListBots -> Maybe Text
$sel:maxResults:ListBots' :: ListBots -> Maybe Natural
$sel:filters:ListBots' :: ListBots -> Maybe (NonEmpty BotFilter)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty BotFilter)
filters
      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 BotSortBy
sortBy

instance Prelude.NFData ListBots where
  rnf :: ListBots -> ()
rnf ListBots' {Maybe Natural
Maybe (NonEmpty BotFilter)
Maybe Text
Maybe BotSortBy
sortBy :: Maybe BotSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (NonEmpty BotFilter)
$sel:sortBy:ListBots' :: ListBots -> Maybe BotSortBy
$sel:nextToken:ListBots' :: ListBots -> Maybe Text
$sel:maxResults:ListBots' :: ListBots -> Maybe Natural
$sel:filters:ListBots' :: ListBots -> Maybe (NonEmpty BotFilter)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty BotFilter)
filters
      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 BotSortBy
sortBy

instance Data.ToHeaders ListBots where
  toHeaders :: ListBots -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListBots where
  toJSON :: ListBots -> Value
toJSON ListBots' {Maybe Natural
Maybe (NonEmpty BotFilter)
Maybe Text
Maybe BotSortBy
sortBy :: Maybe BotSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (NonEmpty BotFilter)
$sel:sortBy:ListBots' :: ListBots -> Maybe BotSortBy
$sel:nextToken:ListBots' :: ListBots -> Maybe Text
$sel:maxResults:ListBots' :: ListBots -> Maybe Natural
$sel:filters:ListBots' :: ListBots -> Maybe (NonEmpty BotFilter)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"filters" 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 (NonEmpty BotFilter)
filters,
            (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
"sortBy" 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 BotSortBy
sortBy
          ]
      )

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

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

-- | /See:/ 'newListBotsResponse' smart constructor.
data ListBotsResponse = ListBotsResponse'
  { -- | Summary information for the bots that meet the filter criteria specified
    -- in the request. The length of the list is specified in the @maxResults@
    -- parameter of the request. If there are more bots available, the
    -- @nextToken@ field contains a token to the next page of results.
    ListBotsResponse -> Maybe [BotSummary]
botSummaries :: Prelude.Maybe [BotSummary],
    -- | A token that indicates whether there are more results to return in a
    -- response to the @ListBots@ operation. If the @nextToken@ field is
    -- present, you send the contents as the @nextToken@ parameter of a
    -- @ListBots@ operation request to get the next page of results.
    ListBotsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListBotsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListBotsResponse -> ListBotsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListBotsResponse -> ListBotsResponse -> Bool
$c/= :: ListBotsResponse -> ListBotsResponse -> Bool
== :: ListBotsResponse -> ListBotsResponse -> Bool
$c== :: ListBotsResponse -> ListBotsResponse -> Bool
Prelude.Eq, ReadPrec [ListBotsResponse]
ReadPrec ListBotsResponse
Int -> ReadS ListBotsResponse
ReadS [ListBotsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListBotsResponse]
$creadListPrec :: ReadPrec [ListBotsResponse]
readPrec :: ReadPrec ListBotsResponse
$creadPrec :: ReadPrec ListBotsResponse
readList :: ReadS [ListBotsResponse]
$creadList :: ReadS [ListBotsResponse]
readsPrec :: Int -> ReadS ListBotsResponse
$creadsPrec :: Int -> ReadS ListBotsResponse
Prelude.Read, Int -> ListBotsResponse -> ShowS
[ListBotsResponse] -> ShowS
ListBotsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListBotsResponse] -> ShowS
$cshowList :: [ListBotsResponse] -> ShowS
show :: ListBotsResponse -> String
$cshow :: ListBotsResponse -> String
showsPrec :: Int -> ListBotsResponse -> ShowS
$cshowsPrec :: Int -> ListBotsResponse -> ShowS
Prelude.Show, forall x. Rep ListBotsResponse x -> ListBotsResponse
forall x. ListBotsResponse -> Rep ListBotsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListBotsResponse x -> ListBotsResponse
$cfrom :: forall x. ListBotsResponse -> Rep ListBotsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListBotsResponse' 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:
--
-- 'botSummaries', 'listBotsResponse_botSummaries' - Summary information for the bots that meet the filter criteria specified
-- in the request. The length of the list is specified in the @maxResults@
-- parameter of the request. If there are more bots available, the
-- @nextToken@ field contains a token to the next page of results.
--
-- 'nextToken', 'listBotsResponse_nextToken' - A token that indicates whether there are more results to return in a
-- response to the @ListBots@ operation. If the @nextToken@ field is
-- present, you send the contents as the @nextToken@ parameter of a
-- @ListBots@ operation request to get the next page of results.
--
-- 'httpStatus', 'listBotsResponse_httpStatus' - The response's http status code.
newListBotsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListBotsResponse
newListBotsResponse :: Int -> ListBotsResponse
newListBotsResponse Int
pHttpStatus_ =
  ListBotsResponse'
    { $sel:botSummaries:ListBotsResponse' :: Maybe [BotSummary]
botSummaries = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListBotsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListBotsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Summary information for the bots that meet the filter criteria specified
-- in the request. The length of the list is specified in the @maxResults@
-- parameter of the request. If there are more bots available, the
-- @nextToken@ field contains a token to the next page of results.
listBotsResponse_botSummaries :: Lens.Lens' ListBotsResponse (Prelude.Maybe [BotSummary])
listBotsResponse_botSummaries :: Lens' ListBotsResponse (Maybe [BotSummary])
listBotsResponse_botSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBotsResponse' {Maybe [BotSummary]
botSummaries :: Maybe [BotSummary]
$sel:botSummaries:ListBotsResponse' :: ListBotsResponse -> Maybe [BotSummary]
botSummaries} -> Maybe [BotSummary]
botSummaries) (\s :: ListBotsResponse
s@ListBotsResponse' {} Maybe [BotSummary]
a -> ListBotsResponse
s {$sel:botSummaries:ListBotsResponse' :: Maybe [BotSummary]
botSummaries = Maybe [BotSummary]
a} :: ListBotsResponse) 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

-- | A token that indicates whether there are more results to return in a
-- response to the @ListBots@ operation. If the @nextToken@ field is
-- present, you send the contents as the @nextToken@ parameter of a
-- @ListBots@ operation request to get the next page of results.
listBotsResponse_nextToken :: Lens.Lens' ListBotsResponse (Prelude.Maybe Prelude.Text)
listBotsResponse_nextToken :: Lens' ListBotsResponse (Maybe Text)
listBotsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListBotsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListBotsResponse' :: ListBotsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListBotsResponse
s@ListBotsResponse' {} Maybe Text
a -> ListBotsResponse
s {$sel:nextToken:ListBotsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListBotsResponse)

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

instance Prelude.NFData ListBotsResponse where
  rnf :: ListBotsResponse -> ()
rnf ListBotsResponse' {Int
Maybe [BotSummary]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
botSummaries :: Maybe [BotSummary]
$sel:httpStatus:ListBotsResponse' :: ListBotsResponse -> Int
$sel:nextToken:ListBotsResponse' :: ListBotsResponse -> Maybe Text
$sel:botSummaries:ListBotsResponse' :: ListBotsResponse -> Maybe [BotSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [BotSummary]
botSummaries
      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