{-# 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.DeviceFarm.ListDevicePools
-- 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 information about device pools.
--
-- This operation returns paginated results.
module Amazonka.DeviceFarm.ListDevicePools
  ( -- * Creating a Request
    ListDevicePools (..),
    newListDevicePools,

    -- * Request Lenses
    listDevicePools_nextToken,
    listDevicePools_type,
    listDevicePools_arn,

    -- * Destructuring the Response
    ListDevicePoolsResponse (..),
    newListDevicePoolsResponse,

    -- * Response Lenses
    listDevicePoolsResponse_devicePools,
    listDevicePoolsResponse_nextToken,
    listDevicePoolsResponse_httpStatus,
  )
where

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

-- | Represents the result of a list device pools request.
--
-- /See:/ 'newListDevicePools' smart constructor.
data ListDevicePools = ListDevicePools'
  { -- | An identifier that was returned from the previous call to this
    -- operation, which can be used to return the next set of items in the
    -- list.
    ListDevicePools -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The device pools\' type.
    --
    -- Allowed values include:
    --
    -- -   CURATED: A device pool that is created and managed by AWS Device
    --     Farm.
    --
    -- -   PRIVATE: A device pool that is created and managed by the device
    --     pool developer.
    ListDevicePools -> Maybe DevicePoolType
type' :: Prelude.Maybe DevicePoolType,
    -- | The project ARN.
    ListDevicePools -> Text
arn :: Prelude.Text
  }
  deriving (ListDevicePools -> ListDevicePools -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDevicePools -> ListDevicePools -> Bool
$c/= :: ListDevicePools -> ListDevicePools -> Bool
== :: ListDevicePools -> ListDevicePools -> Bool
$c== :: ListDevicePools -> ListDevicePools -> Bool
Prelude.Eq, ReadPrec [ListDevicePools]
ReadPrec ListDevicePools
Int -> ReadS ListDevicePools
ReadS [ListDevicePools]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListDevicePools]
$creadListPrec :: ReadPrec [ListDevicePools]
readPrec :: ReadPrec ListDevicePools
$creadPrec :: ReadPrec ListDevicePools
readList :: ReadS [ListDevicePools]
$creadList :: ReadS [ListDevicePools]
readsPrec :: Int -> ReadS ListDevicePools
$creadsPrec :: Int -> ReadS ListDevicePools
Prelude.Read, Int -> ListDevicePools -> ShowS
[ListDevicePools] -> ShowS
ListDevicePools -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDevicePools] -> ShowS
$cshowList :: [ListDevicePools] -> ShowS
show :: ListDevicePools -> String
$cshow :: ListDevicePools -> String
showsPrec :: Int -> ListDevicePools -> ShowS
$cshowsPrec :: Int -> ListDevicePools -> ShowS
Prelude.Show, forall x. Rep ListDevicePools x -> ListDevicePools
forall x. ListDevicePools -> Rep ListDevicePools x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListDevicePools x -> ListDevicePools
$cfrom :: forall x. ListDevicePools -> Rep ListDevicePools x
Prelude.Generic)

-- |
-- Create a value of 'ListDevicePools' 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', 'listDevicePools_nextToken' - An identifier that was returned from the previous call to this
-- operation, which can be used to return the next set of items in the
-- list.
--
-- 'type'', 'listDevicePools_type' - The device pools\' type.
--
-- Allowed values include:
--
-- -   CURATED: A device pool that is created and managed by AWS Device
--     Farm.
--
-- -   PRIVATE: A device pool that is created and managed by the device
--     pool developer.
--
-- 'arn', 'listDevicePools_arn' - The project ARN.
newListDevicePools ::
  -- | 'arn'
  Prelude.Text ->
  ListDevicePools
newListDevicePools :: Text -> ListDevicePools
newListDevicePools Text
pArn_ =
  ListDevicePools'
    { $sel:nextToken:ListDevicePools' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:type':ListDevicePools' :: Maybe DevicePoolType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:ListDevicePools' :: Text
arn = Text
pArn_
    }

-- | An identifier that was returned from the previous call to this
-- operation, which can be used to return the next set of items in the
-- list.
listDevicePools_nextToken :: Lens.Lens' ListDevicePools (Prelude.Maybe Prelude.Text)
listDevicePools_nextToken :: Lens' ListDevicePools (Maybe Text)
listDevicePools_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDevicePools' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDevicePools' :: ListDevicePools -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListDevicePools
s@ListDevicePools' {} Maybe Text
a -> ListDevicePools
s {$sel:nextToken:ListDevicePools' :: Maybe Text
nextToken = Maybe Text
a} :: ListDevicePools)

-- | The device pools\' type.
--
-- Allowed values include:
--
-- -   CURATED: A device pool that is created and managed by AWS Device
--     Farm.
--
-- -   PRIVATE: A device pool that is created and managed by the device
--     pool developer.
listDevicePools_type :: Lens.Lens' ListDevicePools (Prelude.Maybe DevicePoolType)
listDevicePools_type :: Lens' ListDevicePools (Maybe DevicePoolType)
listDevicePools_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDevicePools' {Maybe DevicePoolType
type' :: Maybe DevicePoolType
$sel:type':ListDevicePools' :: ListDevicePools -> Maybe DevicePoolType
type'} -> Maybe DevicePoolType
type') (\s :: ListDevicePools
s@ListDevicePools' {} Maybe DevicePoolType
a -> ListDevicePools
s {$sel:type':ListDevicePools' :: Maybe DevicePoolType
type' = Maybe DevicePoolType
a} :: ListDevicePools)

-- | The project ARN.
listDevicePools_arn :: Lens.Lens' ListDevicePools Prelude.Text
listDevicePools_arn :: Lens' ListDevicePools Text
listDevicePools_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDevicePools' {Text
arn :: Text
$sel:arn:ListDevicePools' :: ListDevicePools -> Text
arn} -> Text
arn) (\s :: ListDevicePools
s@ListDevicePools' {} Text
a -> ListDevicePools
s {$sel:arn:ListDevicePools' :: Text
arn = Text
a} :: ListDevicePools)

instance Core.AWSPager ListDevicePools where
  page :: ListDevicePools
-> AWSResponse ListDevicePools -> Maybe ListDevicePools
page ListDevicePools
rq AWSResponse ListDevicePools
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListDevicePools
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDevicePoolsResponse (Maybe Text)
listDevicePoolsResponse_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 ListDevicePools
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDevicePoolsResponse (Maybe [DevicePool])
listDevicePoolsResponse_devicePools
            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.$ ListDevicePools
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListDevicePools (Maybe Text)
listDevicePools_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListDevicePools
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDevicePoolsResponse (Maybe Text)
listDevicePoolsResponse_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 ListDevicePools where
  type
    AWSResponse ListDevicePools =
      ListDevicePoolsResponse
  request :: (Service -> Service) -> ListDevicePools -> Request ListDevicePools
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 ListDevicePools
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListDevicePools)))
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 [DevicePool] -> Maybe Text -> Int -> ListDevicePoolsResponse
ListDevicePoolsResponse'
            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
"devicePools" 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 ListDevicePools where
  hashWithSalt :: Int -> ListDevicePools -> Int
hashWithSalt Int
_salt ListDevicePools' {Maybe Text
Maybe DevicePoolType
Text
arn :: Text
type' :: Maybe DevicePoolType
nextToken :: Maybe Text
$sel:arn:ListDevicePools' :: ListDevicePools -> Text
$sel:type':ListDevicePools' :: ListDevicePools -> Maybe DevicePoolType
$sel:nextToken:ListDevicePools' :: ListDevicePools -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DevicePoolType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

instance Prelude.NFData ListDevicePools where
  rnf :: ListDevicePools -> ()
rnf ListDevicePools' {Maybe Text
Maybe DevicePoolType
Text
arn :: Text
type' :: Maybe DevicePoolType
nextToken :: Maybe Text
$sel:arn:ListDevicePools' :: ListDevicePools -> Text
$sel:type':ListDevicePools' :: ListDevicePools -> Maybe DevicePoolType
$sel:nextToken:ListDevicePools' :: ListDevicePools -> 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 DevicePoolType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn

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

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

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

-- | Represents the result of a list device pools request.
--
-- /See:/ 'newListDevicePoolsResponse' smart constructor.
data ListDevicePoolsResponse = ListDevicePoolsResponse'
  { -- | Information about the device pools.
    ListDevicePoolsResponse -> Maybe [DevicePool]
devicePools :: Prelude.Maybe [DevicePool],
    -- | If the number of items that are returned is significantly large, this is
    -- an identifier that is also returned. It can be used in a subsequent call
    -- to this operation to return the next set of items in the list.
    ListDevicePoolsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListDevicePoolsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListDevicePoolsResponse -> ListDevicePoolsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDevicePoolsResponse -> ListDevicePoolsResponse -> Bool
$c/= :: ListDevicePoolsResponse -> ListDevicePoolsResponse -> Bool
== :: ListDevicePoolsResponse -> ListDevicePoolsResponse -> Bool
$c== :: ListDevicePoolsResponse -> ListDevicePoolsResponse -> Bool
Prelude.Eq, ReadPrec [ListDevicePoolsResponse]
ReadPrec ListDevicePoolsResponse
Int -> ReadS ListDevicePoolsResponse
ReadS [ListDevicePoolsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListDevicePoolsResponse]
$creadListPrec :: ReadPrec [ListDevicePoolsResponse]
readPrec :: ReadPrec ListDevicePoolsResponse
$creadPrec :: ReadPrec ListDevicePoolsResponse
readList :: ReadS [ListDevicePoolsResponse]
$creadList :: ReadS [ListDevicePoolsResponse]
readsPrec :: Int -> ReadS ListDevicePoolsResponse
$creadsPrec :: Int -> ReadS ListDevicePoolsResponse
Prelude.Read, Int -> ListDevicePoolsResponse -> ShowS
[ListDevicePoolsResponse] -> ShowS
ListDevicePoolsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDevicePoolsResponse] -> ShowS
$cshowList :: [ListDevicePoolsResponse] -> ShowS
show :: ListDevicePoolsResponse -> String
$cshow :: ListDevicePoolsResponse -> String
showsPrec :: Int -> ListDevicePoolsResponse -> ShowS
$cshowsPrec :: Int -> ListDevicePoolsResponse -> ShowS
Prelude.Show, forall x. Rep ListDevicePoolsResponse x -> ListDevicePoolsResponse
forall x. ListDevicePoolsResponse -> Rep ListDevicePoolsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListDevicePoolsResponse x -> ListDevicePoolsResponse
$cfrom :: forall x. ListDevicePoolsResponse -> Rep ListDevicePoolsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListDevicePoolsResponse' 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:
--
-- 'devicePools', 'listDevicePoolsResponse_devicePools' - Information about the device pools.
--
-- 'nextToken', 'listDevicePoolsResponse_nextToken' - If the number of items that are returned is significantly large, this is
-- an identifier that is also returned. It can be used in a subsequent call
-- to this operation to return the next set of items in the list.
--
-- 'httpStatus', 'listDevicePoolsResponse_httpStatus' - The response's http status code.
newListDevicePoolsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListDevicePoolsResponse
newListDevicePoolsResponse :: Int -> ListDevicePoolsResponse
newListDevicePoolsResponse Int
pHttpStatus_ =
  ListDevicePoolsResponse'
    { $sel:devicePools:ListDevicePoolsResponse' :: Maybe [DevicePool]
devicePools =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListDevicePoolsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListDevicePoolsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the device pools.
listDevicePoolsResponse_devicePools :: Lens.Lens' ListDevicePoolsResponse (Prelude.Maybe [DevicePool])
listDevicePoolsResponse_devicePools :: Lens' ListDevicePoolsResponse (Maybe [DevicePool])
listDevicePoolsResponse_devicePools = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDevicePoolsResponse' {Maybe [DevicePool]
devicePools :: Maybe [DevicePool]
$sel:devicePools:ListDevicePoolsResponse' :: ListDevicePoolsResponse -> Maybe [DevicePool]
devicePools} -> Maybe [DevicePool]
devicePools) (\s :: ListDevicePoolsResponse
s@ListDevicePoolsResponse' {} Maybe [DevicePool]
a -> ListDevicePoolsResponse
s {$sel:devicePools:ListDevicePoolsResponse' :: Maybe [DevicePool]
devicePools = Maybe [DevicePool]
a} :: ListDevicePoolsResponse) 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 the number of items that are returned is significantly large, this is
-- an identifier that is also returned. It can be used in a subsequent call
-- to this operation to return the next set of items in the list.
listDevicePoolsResponse_nextToken :: Lens.Lens' ListDevicePoolsResponse (Prelude.Maybe Prelude.Text)
listDevicePoolsResponse_nextToken :: Lens' ListDevicePoolsResponse (Maybe Text)
listDevicePoolsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDevicePoolsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDevicePoolsResponse' :: ListDevicePoolsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListDevicePoolsResponse
s@ListDevicePoolsResponse' {} Maybe Text
a -> ListDevicePoolsResponse
s {$sel:nextToken:ListDevicePoolsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListDevicePoolsResponse)

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

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