{-# 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.ListInstalledComponents
-- 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 the components that a Greengrass core
-- device runs. By default, this list doesn\'t include components that are
-- deployed as dependencies of other components. To include dependencies in
-- the response, set the @topologyFilter@ parameter to @ALL@.
--
-- 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.ListInstalledComponents
  ( -- * Creating a Request
    ListInstalledComponents (..),
    newListInstalledComponents,

    -- * Request Lenses
    listInstalledComponents_maxResults,
    listInstalledComponents_nextToken,
    listInstalledComponents_topologyFilter,
    listInstalledComponents_coreDeviceThingName,

    -- * Destructuring the Response
    ListInstalledComponentsResponse (..),
    newListInstalledComponentsResponse,

    -- * Response Lenses
    listInstalledComponentsResponse_installedComponents,
    listInstalledComponentsResponse_nextToken,
    listInstalledComponentsResponse_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:/ 'newListInstalledComponents' smart constructor.
data ListInstalledComponents = ListInstalledComponents'
  { -- | The maximum number of results to be returned per paginated request.
    ListInstalledComponents -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token to be used for the next set of paginated results.
    ListInstalledComponents -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The filter for the list of components. Choose from the following
    -- options:
    --
    -- -   @ALL@ – The list includes all components installed on the core
    --     device.
    --
    -- -   @ROOT@ – The list includes only /root/ components, which are
    --     components that you specify in a deployment. When you choose this
    --     option, the list doesn\'t include components that the core device
    --     installs as dependencies of other components.
    --
    -- Default: @ROOT@
    ListInstalledComponents -> Maybe InstalledComponentTopologyFilter
topologyFilter :: Prelude.Maybe InstalledComponentTopologyFilter,
    -- | The name of the core device. This is also the name of the IoT thing.
    ListInstalledComponents -> Text
coreDeviceThingName :: Prelude.Text
  }
  deriving (ListInstalledComponents -> ListInstalledComponents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListInstalledComponents -> ListInstalledComponents -> Bool
$c/= :: ListInstalledComponents -> ListInstalledComponents -> Bool
== :: ListInstalledComponents -> ListInstalledComponents -> Bool
$c== :: ListInstalledComponents -> ListInstalledComponents -> Bool
Prelude.Eq, ReadPrec [ListInstalledComponents]
ReadPrec ListInstalledComponents
Int -> ReadS ListInstalledComponents
ReadS [ListInstalledComponents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListInstalledComponents]
$creadListPrec :: ReadPrec [ListInstalledComponents]
readPrec :: ReadPrec ListInstalledComponents
$creadPrec :: ReadPrec ListInstalledComponents
readList :: ReadS [ListInstalledComponents]
$creadList :: ReadS [ListInstalledComponents]
readsPrec :: Int -> ReadS ListInstalledComponents
$creadsPrec :: Int -> ReadS ListInstalledComponents
Prelude.Read, Int -> ListInstalledComponents -> ShowS
[ListInstalledComponents] -> ShowS
ListInstalledComponents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListInstalledComponents] -> ShowS
$cshowList :: [ListInstalledComponents] -> ShowS
show :: ListInstalledComponents -> String
$cshow :: ListInstalledComponents -> String
showsPrec :: Int -> ListInstalledComponents -> ShowS
$cshowsPrec :: Int -> ListInstalledComponents -> ShowS
Prelude.Show, forall x. Rep ListInstalledComponents x -> ListInstalledComponents
forall x. ListInstalledComponents -> Rep ListInstalledComponents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListInstalledComponents x -> ListInstalledComponents
$cfrom :: forall x. ListInstalledComponents -> Rep ListInstalledComponents x
Prelude.Generic)

-- |
-- Create a value of 'ListInstalledComponents' 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', 'listInstalledComponents_maxResults' - The maximum number of results to be returned per paginated request.
--
-- 'nextToken', 'listInstalledComponents_nextToken' - The token to be used for the next set of paginated results.
--
-- 'topologyFilter', 'listInstalledComponents_topologyFilter' - The filter for the list of components. Choose from the following
-- options:
--
-- -   @ALL@ – The list includes all components installed on the core
--     device.
--
-- -   @ROOT@ – The list includes only /root/ components, which are
--     components that you specify in a deployment. When you choose this
--     option, the list doesn\'t include components that the core device
--     installs as dependencies of other components.
--
-- Default: @ROOT@
--
-- 'coreDeviceThingName', 'listInstalledComponents_coreDeviceThingName' - The name of the core device. This is also the name of the IoT thing.
newListInstalledComponents ::
  -- | 'coreDeviceThingName'
  Prelude.Text ->
  ListInstalledComponents
newListInstalledComponents :: Text -> ListInstalledComponents
newListInstalledComponents Text
pCoreDeviceThingName_ =
  ListInstalledComponents'
    { $sel:maxResults:ListInstalledComponents' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListInstalledComponents' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:topologyFilter:ListInstalledComponents' :: Maybe InstalledComponentTopologyFilter
topologyFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:coreDeviceThingName:ListInstalledComponents' :: Text
coreDeviceThingName = Text
pCoreDeviceThingName_
    }

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

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

-- | The filter for the list of components. Choose from the following
-- options:
--
-- -   @ALL@ – The list includes all components installed on the core
--     device.
--
-- -   @ROOT@ – The list includes only /root/ components, which are
--     components that you specify in a deployment. When you choose this
--     option, the list doesn\'t include components that the core device
--     installs as dependencies of other components.
--
-- Default: @ROOT@
listInstalledComponents_topologyFilter :: Lens.Lens' ListInstalledComponents (Prelude.Maybe InstalledComponentTopologyFilter)
listInstalledComponents_topologyFilter :: Lens'
  ListInstalledComponents (Maybe InstalledComponentTopologyFilter)
listInstalledComponents_topologyFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstalledComponents' {Maybe InstalledComponentTopologyFilter
topologyFilter :: Maybe InstalledComponentTopologyFilter
$sel:topologyFilter:ListInstalledComponents' :: ListInstalledComponents -> Maybe InstalledComponentTopologyFilter
topologyFilter} -> Maybe InstalledComponentTopologyFilter
topologyFilter) (\s :: ListInstalledComponents
s@ListInstalledComponents' {} Maybe InstalledComponentTopologyFilter
a -> ListInstalledComponents
s {$sel:topologyFilter:ListInstalledComponents' :: Maybe InstalledComponentTopologyFilter
topologyFilter = Maybe InstalledComponentTopologyFilter
a} :: ListInstalledComponents)

-- | The name of the core device. This is also the name of the IoT thing.
listInstalledComponents_coreDeviceThingName :: Lens.Lens' ListInstalledComponents Prelude.Text
listInstalledComponents_coreDeviceThingName :: Lens' ListInstalledComponents Text
listInstalledComponents_coreDeviceThingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstalledComponents' {Text
coreDeviceThingName :: Text
$sel:coreDeviceThingName:ListInstalledComponents' :: ListInstalledComponents -> Text
coreDeviceThingName} -> Text
coreDeviceThingName) (\s :: ListInstalledComponents
s@ListInstalledComponents' {} Text
a -> ListInstalledComponents
s {$sel:coreDeviceThingName:ListInstalledComponents' :: Text
coreDeviceThingName = Text
a} :: ListInstalledComponents)

instance Core.AWSPager ListInstalledComponents where
  page :: ListInstalledComponents
-> AWSResponse ListInstalledComponents
-> Maybe ListInstalledComponents
page ListInstalledComponents
rq AWSResponse ListInstalledComponents
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListInstalledComponents
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListInstalledComponentsResponse (Maybe Text)
listInstalledComponentsResponse_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 ListInstalledComponents
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListInstalledComponentsResponse (Maybe [InstalledComponent])
listInstalledComponentsResponse_installedComponents
            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.$ ListInstalledComponents
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListInstalledComponents (Maybe Text)
listInstalledComponents_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListInstalledComponents
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListInstalledComponentsResponse (Maybe Text)
listInstalledComponentsResponse_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 ListInstalledComponents where
  type
    AWSResponse ListInstalledComponents =
      ListInstalledComponentsResponse
  request :: (Service -> Service)
-> ListInstalledComponents -> Request ListInstalledComponents
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 ListInstalledComponents
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListInstalledComponents)))
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 [InstalledComponent]
-> Maybe Text -> Int -> ListInstalledComponentsResponse
ListInstalledComponentsResponse'
            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
"installedComponents"
                            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 ListInstalledComponents where
  hashWithSalt :: Int -> ListInstalledComponents -> Int
hashWithSalt Int
_salt ListInstalledComponents' {Maybe Natural
Maybe Text
Maybe InstalledComponentTopologyFilter
Text
coreDeviceThingName :: Text
topologyFilter :: Maybe InstalledComponentTopologyFilter
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:coreDeviceThingName:ListInstalledComponents' :: ListInstalledComponents -> Text
$sel:topologyFilter:ListInstalledComponents' :: ListInstalledComponents -> Maybe InstalledComponentTopologyFilter
$sel:nextToken:ListInstalledComponents' :: ListInstalledComponents -> Maybe Text
$sel:maxResults:ListInstalledComponents' :: ListInstalledComponents -> 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 InstalledComponentTopologyFilter
topologyFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
coreDeviceThingName

instance Prelude.NFData ListInstalledComponents where
  rnf :: ListInstalledComponents -> ()
rnf ListInstalledComponents' {Maybe Natural
Maybe Text
Maybe InstalledComponentTopologyFilter
Text
coreDeviceThingName :: Text
topologyFilter :: Maybe InstalledComponentTopologyFilter
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:coreDeviceThingName:ListInstalledComponents' :: ListInstalledComponents -> Text
$sel:topologyFilter:ListInstalledComponents' :: ListInstalledComponents -> Maybe InstalledComponentTopologyFilter
$sel:nextToken:ListInstalledComponents' :: ListInstalledComponents -> Maybe Text
$sel:maxResults:ListInstalledComponents' :: ListInstalledComponents -> 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 InstalledComponentTopologyFilter
topologyFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
coreDeviceThingName

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

instance Data.ToPath ListInstalledComponents where
  toPath :: ListInstalledComponents -> ByteString
toPath ListInstalledComponents' {Maybe Natural
Maybe Text
Maybe InstalledComponentTopologyFilter
Text
coreDeviceThingName :: Text
topologyFilter :: Maybe InstalledComponentTopologyFilter
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:coreDeviceThingName:ListInstalledComponents' :: ListInstalledComponents -> Text
$sel:topologyFilter:ListInstalledComponents' :: ListInstalledComponents -> Maybe InstalledComponentTopologyFilter
$sel:nextToken:ListInstalledComponents' :: ListInstalledComponents -> Maybe Text
$sel:maxResults:ListInstalledComponents' :: ListInstalledComponents -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/greengrass/v2/coreDevices/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
coreDeviceThingName,
        ByteString
"/installedComponents"
      ]

instance Data.ToQuery ListInstalledComponents where
  toQuery :: ListInstalledComponents -> QueryString
toQuery ListInstalledComponents' {Maybe Natural
Maybe Text
Maybe InstalledComponentTopologyFilter
Text
coreDeviceThingName :: Text
topologyFilter :: Maybe InstalledComponentTopologyFilter
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:coreDeviceThingName:ListInstalledComponents' :: ListInstalledComponents -> Text
$sel:topologyFilter:ListInstalledComponents' :: ListInstalledComponents -> Maybe InstalledComponentTopologyFilter
$sel:nextToken:ListInstalledComponents' :: ListInstalledComponents -> Maybe Text
$sel:maxResults:ListInstalledComponents' :: ListInstalledComponents -> 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
"topologyFilter" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe InstalledComponentTopologyFilter
topologyFilter
      ]

-- | /See:/ 'newListInstalledComponentsResponse' smart constructor.
data ListInstalledComponentsResponse = ListInstalledComponentsResponse'
  { -- | A list that summarizes each component on the core device.
    --
    -- Greengrass nucleus v2.7.0 or later is required to get an accurate
    -- @lastStatusChangeTimestamp@ response. This response can be inaccurate in
    -- earlier Greengrass nucleus versions.
    --
    -- Greengrass nucleus v2.8.0 or later is required to get an accurate
    -- @lastInstallationSource@ and @lastReportedTimestamp@ response. This
    -- response can be inaccurate or null in earlier Greengrass nucleus
    -- versions.
    ListInstalledComponentsResponse -> Maybe [InstalledComponent]
installedComponents :: Prelude.Maybe [InstalledComponent],
    -- | The token for the next set of results, or null if there are no
    -- additional results.
    ListInstalledComponentsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListInstalledComponentsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListInstalledComponentsResponse
-> ListInstalledComponentsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListInstalledComponentsResponse
-> ListInstalledComponentsResponse -> Bool
$c/= :: ListInstalledComponentsResponse
-> ListInstalledComponentsResponse -> Bool
== :: ListInstalledComponentsResponse
-> ListInstalledComponentsResponse -> Bool
$c== :: ListInstalledComponentsResponse
-> ListInstalledComponentsResponse -> Bool
Prelude.Eq, ReadPrec [ListInstalledComponentsResponse]
ReadPrec ListInstalledComponentsResponse
Int -> ReadS ListInstalledComponentsResponse
ReadS [ListInstalledComponentsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListInstalledComponentsResponse]
$creadListPrec :: ReadPrec [ListInstalledComponentsResponse]
readPrec :: ReadPrec ListInstalledComponentsResponse
$creadPrec :: ReadPrec ListInstalledComponentsResponse
readList :: ReadS [ListInstalledComponentsResponse]
$creadList :: ReadS [ListInstalledComponentsResponse]
readsPrec :: Int -> ReadS ListInstalledComponentsResponse
$creadsPrec :: Int -> ReadS ListInstalledComponentsResponse
Prelude.Read, Int -> ListInstalledComponentsResponse -> ShowS
[ListInstalledComponentsResponse] -> ShowS
ListInstalledComponentsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListInstalledComponentsResponse] -> ShowS
$cshowList :: [ListInstalledComponentsResponse] -> ShowS
show :: ListInstalledComponentsResponse -> String
$cshow :: ListInstalledComponentsResponse -> String
showsPrec :: Int -> ListInstalledComponentsResponse -> ShowS
$cshowsPrec :: Int -> ListInstalledComponentsResponse -> ShowS
Prelude.Show, forall x.
Rep ListInstalledComponentsResponse x
-> ListInstalledComponentsResponse
forall x.
ListInstalledComponentsResponse
-> Rep ListInstalledComponentsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListInstalledComponentsResponse x
-> ListInstalledComponentsResponse
$cfrom :: forall x.
ListInstalledComponentsResponse
-> Rep ListInstalledComponentsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListInstalledComponentsResponse' 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:
--
-- 'installedComponents', 'listInstalledComponentsResponse_installedComponents' - A list that summarizes each component on the core device.
--
-- Greengrass nucleus v2.7.0 or later is required to get an accurate
-- @lastStatusChangeTimestamp@ response. This response can be inaccurate in
-- earlier Greengrass nucleus versions.
--
-- Greengrass nucleus v2.8.0 or later is required to get an accurate
-- @lastInstallationSource@ and @lastReportedTimestamp@ response. This
-- response can be inaccurate or null in earlier Greengrass nucleus
-- versions.
--
-- 'nextToken', 'listInstalledComponentsResponse_nextToken' - The token for the next set of results, or null if there are no
-- additional results.
--
-- 'httpStatus', 'listInstalledComponentsResponse_httpStatus' - The response's http status code.
newListInstalledComponentsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListInstalledComponentsResponse
newListInstalledComponentsResponse :: Int -> ListInstalledComponentsResponse
newListInstalledComponentsResponse Int
pHttpStatus_ =
  ListInstalledComponentsResponse'
    { $sel:installedComponents:ListInstalledComponentsResponse' :: Maybe [InstalledComponent]
installedComponents =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListInstalledComponentsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListInstalledComponentsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list that summarizes each component on the core device.
--
-- Greengrass nucleus v2.7.0 or later is required to get an accurate
-- @lastStatusChangeTimestamp@ response. This response can be inaccurate in
-- earlier Greengrass nucleus versions.
--
-- Greengrass nucleus v2.8.0 or later is required to get an accurate
-- @lastInstallationSource@ and @lastReportedTimestamp@ response. This
-- response can be inaccurate or null in earlier Greengrass nucleus
-- versions.
listInstalledComponentsResponse_installedComponents :: Lens.Lens' ListInstalledComponentsResponse (Prelude.Maybe [InstalledComponent])
listInstalledComponentsResponse_installedComponents :: Lens' ListInstalledComponentsResponse (Maybe [InstalledComponent])
listInstalledComponentsResponse_installedComponents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstalledComponentsResponse' {Maybe [InstalledComponent]
installedComponents :: Maybe [InstalledComponent]
$sel:installedComponents:ListInstalledComponentsResponse' :: ListInstalledComponentsResponse -> Maybe [InstalledComponent]
installedComponents} -> Maybe [InstalledComponent]
installedComponents) (\s :: ListInstalledComponentsResponse
s@ListInstalledComponentsResponse' {} Maybe [InstalledComponent]
a -> ListInstalledComponentsResponse
s {$sel:installedComponents:ListInstalledComponentsResponse' :: Maybe [InstalledComponent]
installedComponents = Maybe [InstalledComponent]
a} :: ListInstalledComponentsResponse) 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.
listInstalledComponentsResponse_nextToken :: Lens.Lens' ListInstalledComponentsResponse (Prelude.Maybe Prelude.Text)
listInstalledComponentsResponse_nextToken :: Lens' ListInstalledComponentsResponse (Maybe Text)
listInstalledComponentsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstalledComponentsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListInstalledComponentsResponse' :: ListInstalledComponentsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListInstalledComponentsResponse
s@ListInstalledComponentsResponse' {} Maybe Text
a -> ListInstalledComponentsResponse
s {$sel:nextToken:ListInstalledComponentsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListInstalledComponentsResponse)

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

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