{-# 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.GreengrassV2.ListCoreDevices
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a paginated list of Greengrass core devices.
--
-- IoT Greengrass relies on individual devices to send status updates to
-- the Amazon Web Services Cloud. If the IoT Greengrass Core software
-- isn\'t running on the device, or if device isn\'t connected to the
-- Amazon Web Services Cloud, then the reported status of that device might
-- not reflect its current status. The status timestamp indicates when the
-- device status was last updated.
--
-- Core devices send status updates at the following times:
--
-- -   When the IoT Greengrass Core software starts
--
-- -   When the core device receives a deployment from the Amazon Web
--     Services Cloud
--
-- -   When the status of any component on the core device becomes @BROKEN@
--
-- -   At a
--     <https://docs.aws.amazon.com/greengrass/v2/developerguide/greengrass-nucleus-component.html#greengrass-nucleus-component-configuration-fss regular interval that you can configure>,
--     which defaults to 24 hours
--
-- -   For IoT Greengrass Core v2.7.0, the core device sends status updates
--     upon local deployment and cloud deployment
--
-- This operation returns paginated results.
module Amazonka.GreengrassV2.ListCoreDevices
  ( -- * Creating a Request
    ListCoreDevices (..),
    newListCoreDevices,

    -- * Request Lenses
    listCoreDevices_maxResults,
    listCoreDevices_nextToken,
    listCoreDevices_status,
    listCoreDevices_thingGroupArn,

    -- * Destructuring the Response
    ListCoreDevicesResponse (..),
    newListCoreDevicesResponse,

    -- * Response Lenses
    listCoreDevicesResponse_coreDevices,
    listCoreDevicesResponse_nextToken,
    listCoreDevicesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListCoreDevices' smart constructor.
data ListCoreDevices = ListCoreDevices'
  { -- | The maximum number of results to be returned per paginated request.
    ListCoreDevices -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token to be used for the next set of paginated results.
    ListCoreDevices -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The core device status by which to filter. If you specify this
    -- parameter, the list includes only core devices that have this status.
    -- Choose one of the following options:
    --
    -- -   @HEALTHY@ – The IoT Greengrass Core software and all components run
    --     on the core device without issue.
    --
    -- -   @UNHEALTHY@ – The IoT Greengrass Core software or a component is in
    --     a failed state on the core device.
    ListCoreDevices -> Maybe CoreDeviceStatus
status :: Prelude.Maybe CoreDeviceStatus,
    -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- of the IoT thing group by which to filter. If you specify this
    -- parameter, the list includes only core devices that have successfully
    -- deployed a deployment that targets the thing group. When you remove a
    -- core device from a thing group, the list continues to include that core
    -- device.
    ListCoreDevices -> Maybe Text
thingGroupArn :: Prelude.Maybe Prelude.Text
  }
  deriving (ListCoreDevices -> ListCoreDevices -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCoreDevices -> ListCoreDevices -> Bool
$c/= :: ListCoreDevices -> ListCoreDevices -> Bool
== :: ListCoreDevices -> ListCoreDevices -> Bool
$c== :: ListCoreDevices -> ListCoreDevices -> Bool
Prelude.Eq, ReadPrec [ListCoreDevices]
ReadPrec ListCoreDevices
Int -> ReadS ListCoreDevices
ReadS [ListCoreDevices]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCoreDevices]
$creadListPrec :: ReadPrec [ListCoreDevices]
readPrec :: ReadPrec ListCoreDevices
$creadPrec :: ReadPrec ListCoreDevices
readList :: ReadS [ListCoreDevices]
$creadList :: ReadS [ListCoreDevices]
readsPrec :: Int -> ReadS ListCoreDevices
$creadsPrec :: Int -> ReadS ListCoreDevices
Prelude.Read, Int -> ListCoreDevices -> ShowS
[ListCoreDevices] -> ShowS
ListCoreDevices -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCoreDevices] -> ShowS
$cshowList :: [ListCoreDevices] -> ShowS
show :: ListCoreDevices -> String
$cshow :: ListCoreDevices -> String
showsPrec :: Int -> ListCoreDevices -> ShowS
$cshowsPrec :: Int -> ListCoreDevices -> ShowS
Prelude.Show, forall x. Rep ListCoreDevices x -> ListCoreDevices
forall x. ListCoreDevices -> Rep ListCoreDevices x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCoreDevices x -> ListCoreDevices
$cfrom :: forall x. ListCoreDevices -> Rep ListCoreDevices x
Prelude.Generic)

-- |
-- Create a value of 'ListCoreDevices' 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:
--
-- 'maxResults', 'listCoreDevices_maxResults' - The maximum number of results to be returned per paginated request.
--
-- 'nextToken', 'listCoreDevices_nextToken' - The token to be used for the next set of paginated results.
--
-- 'status', 'listCoreDevices_status' - The core device status by which to filter. If you specify this
-- parameter, the list includes only core devices that have this status.
-- Choose one of the following options:
--
-- -   @HEALTHY@ – The IoT Greengrass Core software and all components run
--     on the core device without issue.
--
-- -   @UNHEALTHY@ – The IoT Greengrass Core software or a component is in
--     a failed state on the core device.
--
-- 'thingGroupArn', 'listCoreDevices_thingGroupArn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the IoT thing group by which to filter. If you specify this
-- parameter, the list includes only core devices that have successfully
-- deployed a deployment that targets the thing group. When you remove a
-- core device from a thing group, the list continues to include that core
-- device.
newListCoreDevices ::
  ListCoreDevices
newListCoreDevices :: ListCoreDevices
newListCoreDevices =
  ListCoreDevices'
    { $sel:maxResults:ListCoreDevices' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCoreDevices' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ListCoreDevices' :: Maybe CoreDeviceStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:thingGroupArn:ListCoreDevices' :: Maybe Text
thingGroupArn = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of results to be returned per paginated request.
listCoreDevices_maxResults :: Lens.Lens' ListCoreDevices (Prelude.Maybe Prelude.Natural)
listCoreDevices_maxResults :: Lens' ListCoreDevices (Maybe Natural)
listCoreDevices_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCoreDevices' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListCoreDevices' :: ListCoreDevices -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListCoreDevices
s@ListCoreDevices' {} Maybe Natural
a -> ListCoreDevices
s {$sel:maxResults:ListCoreDevices' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListCoreDevices)

-- | The token to be used for the next set of paginated results.
listCoreDevices_nextToken :: Lens.Lens' ListCoreDevices (Prelude.Maybe Prelude.Text)
listCoreDevices_nextToken :: Lens' ListCoreDevices (Maybe Text)
listCoreDevices_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCoreDevices' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCoreDevices' :: ListCoreDevices -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCoreDevices
s@ListCoreDevices' {} Maybe Text
a -> ListCoreDevices
s {$sel:nextToken:ListCoreDevices' :: Maybe Text
nextToken = Maybe Text
a} :: ListCoreDevices)

-- | The core device status by which to filter. If you specify this
-- parameter, the list includes only core devices that have this status.
-- Choose one of the following options:
--
-- -   @HEALTHY@ – The IoT Greengrass Core software and all components run
--     on the core device without issue.
--
-- -   @UNHEALTHY@ – The IoT Greengrass Core software or a component is in
--     a failed state on the core device.
listCoreDevices_status :: Lens.Lens' ListCoreDevices (Prelude.Maybe CoreDeviceStatus)
listCoreDevices_status :: Lens' ListCoreDevices (Maybe CoreDeviceStatus)
listCoreDevices_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCoreDevices' {Maybe CoreDeviceStatus
status :: Maybe CoreDeviceStatus
$sel:status:ListCoreDevices' :: ListCoreDevices -> Maybe CoreDeviceStatus
status} -> Maybe CoreDeviceStatus
status) (\s :: ListCoreDevices
s@ListCoreDevices' {} Maybe CoreDeviceStatus
a -> ListCoreDevices
s {$sel:status:ListCoreDevices' :: Maybe CoreDeviceStatus
status = Maybe CoreDeviceStatus
a} :: ListCoreDevices)

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the IoT thing group by which to filter. If you specify this
-- parameter, the list includes only core devices that have successfully
-- deployed a deployment that targets the thing group. When you remove a
-- core device from a thing group, the list continues to include that core
-- device.
listCoreDevices_thingGroupArn :: Lens.Lens' ListCoreDevices (Prelude.Maybe Prelude.Text)
listCoreDevices_thingGroupArn :: Lens' ListCoreDevices (Maybe Text)
listCoreDevices_thingGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCoreDevices' {Maybe Text
thingGroupArn :: Maybe Text
$sel:thingGroupArn:ListCoreDevices' :: ListCoreDevices -> Maybe Text
thingGroupArn} -> Maybe Text
thingGroupArn) (\s :: ListCoreDevices
s@ListCoreDevices' {} Maybe Text
a -> ListCoreDevices
s {$sel:thingGroupArn:ListCoreDevices' :: Maybe Text
thingGroupArn = Maybe Text
a} :: ListCoreDevices)

instance Core.AWSPager ListCoreDevices where
  page :: ListCoreDevices
-> AWSResponse ListCoreDevices -> Maybe ListCoreDevices
page ListCoreDevices
rq AWSResponse ListCoreDevices
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCoreDevices
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCoreDevicesResponse (Maybe Text)
listCoreDevicesResponse_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 ListCoreDevices
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCoreDevicesResponse (Maybe [CoreDevice])
listCoreDevicesResponse_coreDevices
            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.$ ListCoreDevices
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListCoreDevices (Maybe Text)
listCoreDevices_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListCoreDevices
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCoreDevicesResponse (Maybe Text)
listCoreDevicesResponse_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 ListCoreDevices where
  type
    AWSResponse ListCoreDevices =
      ListCoreDevicesResponse
  request :: (Service -> Service) -> ListCoreDevices -> Request ListCoreDevices
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListCoreDevices
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListCoreDevices)))
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 [CoreDevice] -> Maybe Text -> Int -> ListCoreDevicesResponse
ListCoreDevicesResponse'
            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
"coreDevices" 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 ListCoreDevices where
  hashWithSalt :: Int -> ListCoreDevices -> Int
hashWithSalt Int
_salt ListCoreDevices' {Maybe Natural
Maybe Text
Maybe CoreDeviceStatus
thingGroupArn :: Maybe Text
status :: Maybe CoreDeviceStatus
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:thingGroupArn:ListCoreDevices' :: ListCoreDevices -> Maybe Text
$sel:status:ListCoreDevices' :: ListCoreDevices -> Maybe CoreDeviceStatus
$sel:nextToken:ListCoreDevices' :: ListCoreDevices -> Maybe Text
$sel:maxResults:ListCoreDevices' :: ListCoreDevices -> Maybe Natural
..} =
    Int
_salt
      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 CoreDeviceStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
thingGroupArn

instance Prelude.NFData ListCoreDevices where
  rnf :: ListCoreDevices -> ()
rnf ListCoreDevices' {Maybe Natural
Maybe Text
Maybe CoreDeviceStatus
thingGroupArn :: Maybe Text
status :: Maybe CoreDeviceStatus
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:thingGroupArn:ListCoreDevices' :: ListCoreDevices -> Maybe Text
$sel:status:ListCoreDevices' :: ListCoreDevices -> Maybe CoreDeviceStatus
$sel:nextToken:ListCoreDevices' :: ListCoreDevices -> Maybe Text
$sel:maxResults:ListCoreDevices' :: ListCoreDevices -> Maybe Natural
..} =
    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 CoreDeviceStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thingGroupArn

instance Data.ToHeaders ListCoreDevices where
  toHeaders :: ListCoreDevices -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath ListCoreDevices where
  toPath :: ListCoreDevices -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/greengrass/v2/coreDevices"

instance Data.ToQuery ListCoreDevices where
  toQuery :: ListCoreDevices -> QueryString
toQuery ListCoreDevices' {Maybe Natural
Maybe Text
Maybe CoreDeviceStatus
thingGroupArn :: Maybe Text
status :: Maybe CoreDeviceStatus
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:thingGroupArn:ListCoreDevices' :: ListCoreDevices -> Maybe Text
$sel:status:ListCoreDevices' :: ListCoreDevices -> Maybe CoreDeviceStatus
$sel:nextToken:ListCoreDevices' :: ListCoreDevices -> Maybe Text
$sel:maxResults:ListCoreDevices' :: ListCoreDevices -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"status" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CoreDeviceStatus
status,
        ByteString
"thingGroupArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
thingGroupArn
      ]

-- | /See:/ 'newListCoreDevicesResponse' smart constructor.
data ListCoreDevicesResponse = ListCoreDevicesResponse'
  { -- | A list that summarizes each core device.
    ListCoreDevicesResponse -> Maybe [CoreDevice]
coreDevices :: Prelude.Maybe [CoreDevice],
    -- | The token for the next set of results, or null if there are no
    -- additional results.
    ListCoreDevicesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCoreDevicesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCoreDevicesResponse -> ListCoreDevicesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCoreDevicesResponse -> ListCoreDevicesResponse -> Bool
$c/= :: ListCoreDevicesResponse -> ListCoreDevicesResponse -> Bool
== :: ListCoreDevicesResponse -> ListCoreDevicesResponse -> Bool
$c== :: ListCoreDevicesResponse -> ListCoreDevicesResponse -> Bool
Prelude.Eq, ReadPrec [ListCoreDevicesResponse]
ReadPrec ListCoreDevicesResponse
Int -> ReadS ListCoreDevicesResponse
ReadS [ListCoreDevicesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCoreDevicesResponse]
$creadListPrec :: ReadPrec [ListCoreDevicesResponse]
readPrec :: ReadPrec ListCoreDevicesResponse
$creadPrec :: ReadPrec ListCoreDevicesResponse
readList :: ReadS [ListCoreDevicesResponse]
$creadList :: ReadS [ListCoreDevicesResponse]
readsPrec :: Int -> ReadS ListCoreDevicesResponse
$creadsPrec :: Int -> ReadS ListCoreDevicesResponse
Prelude.Read, Int -> ListCoreDevicesResponse -> ShowS
[ListCoreDevicesResponse] -> ShowS
ListCoreDevicesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCoreDevicesResponse] -> ShowS
$cshowList :: [ListCoreDevicesResponse] -> ShowS
show :: ListCoreDevicesResponse -> String
$cshow :: ListCoreDevicesResponse -> String
showsPrec :: Int -> ListCoreDevicesResponse -> ShowS
$cshowsPrec :: Int -> ListCoreDevicesResponse -> ShowS
Prelude.Show, forall x. Rep ListCoreDevicesResponse x -> ListCoreDevicesResponse
forall x. ListCoreDevicesResponse -> Rep ListCoreDevicesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCoreDevicesResponse x -> ListCoreDevicesResponse
$cfrom :: forall x. ListCoreDevicesResponse -> Rep ListCoreDevicesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCoreDevicesResponse' 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:
--
-- 'coreDevices', 'listCoreDevicesResponse_coreDevices' - A list that summarizes each core device.
--
-- 'nextToken', 'listCoreDevicesResponse_nextToken' - The token for the next set of results, or null if there are no
-- additional results.
--
-- 'httpStatus', 'listCoreDevicesResponse_httpStatus' - The response's http status code.
newListCoreDevicesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCoreDevicesResponse
newListCoreDevicesResponse :: Int -> ListCoreDevicesResponse
newListCoreDevicesResponse Int
pHttpStatus_ =
  ListCoreDevicesResponse'
    { $sel:coreDevices:ListCoreDevicesResponse' :: Maybe [CoreDevice]
coreDevices =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCoreDevicesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCoreDevicesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list that summarizes each core device.
listCoreDevicesResponse_coreDevices :: Lens.Lens' ListCoreDevicesResponse (Prelude.Maybe [CoreDevice])
listCoreDevicesResponse_coreDevices :: Lens' ListCoreDevicesResponse (Maybe [CoreDevice])
listCoreDevicesResponse_coreDevices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCoreDevicesResponse' {Maybe [CoreDevice]
coreDevices :: Maybe [CoreDevice]
$sel:coreDevices:ListCoreDevicesResponse' :: ListCoreDevicesResponse -> Maybe [CoreDevice]
coreDevices} -> Maybe [CoreDevice]
coreDevices) (\s :: ListCoreDevicesResponse
s@ListCoreDevicesResponse' {} Maybe [CoreDevice]
a -> ListCoreDevicesResponse
s {$sel:coreDevices:ListCoreDevicesResponse' :: Maybe [CoreDevice]
coreDevices = Maybe [CoreDevice]
a} :: ListCoreDevicesResponse) 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 token for the next set of results, or null if there are no
-- additional results.
listCoreDevicesResponse_nextToken :: Lens.Lens' ListCoreDevicesResponse (Prelude.Maybe Prelude.Text)
listCoreDevicesResponse_nextToken :: Lens' ListCoreDevicesResponse (Maybe Text)
listCoreDevicesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCoreDevicesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCoreDevicesResponse' :: ListCoreDevicesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCoreDevicesResponse
s@ListCoreDevicesResponse' {} Maybe Text
a -> ListCoreDevicesResponse
s {$sel:nextToken:ListCoreDevicesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListCoreDevicesResponse)

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

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