{-# 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.SageMaker.ListStageDevices
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists devices allocated to the stage, containing detailed device
-- information and deployment status.
--
-- This operation returns paginated results.
module Amazonka.SageMaker.ListStageDevices
  ( -- * Creating a Request
    ListStageDevices (..),
    newListStageDevices,

    -- * Request Lenses
    listStageDevices_excludeDevicesDeployedInOtherStage,
    listStageDevices_maxResults,
    listStageDevices_nextToken,
    listStageDevices_edgeDeploymentPlanName,
    listStageDevices_stageName,

    -- * Destructuring the Response
    ListStageDevicesResponse (..),
    newListStageDevicesResponse,

    -- * Response Lenses
    listStageDevicesResponse_nextToken,
    listStageDevicesResponse_httpStatus,
    listStageDevicesResponse_deviceDeploymentSummaries,
  )
where

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

-- | /See:/ 'newListStageDevices' smart constructor.
data ListStageDevices = ListStageDevices'
  { -- | Toggle for excluding devices deployed in other stages.
    ListStageDevices -> Maybe Bool
excludeDevicesDeployedInOtherStage :: Prelude.Maybe Prelude.Bool,
    -- | The maximum number of requests to select.
    ListStageDevices -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | The response from the last list when returning a list large enough to
    -- neeed tokening.
    ListStageDevices -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the edge deployment plan.
    ListStageDevices -> Text
edgeDeploymentPlanName :: Prelude.Text,
    -- | The name of the stage in the deployment.
    ListStageDevices -> Text
stageName :: Prelude.Text
  }
  deriving (ListStageDevices -> ListStageDevices -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStageDevices -> ListStageDevices -> Bool
$c/= :: ListStageDevices -> ListStageDevices -> Bool
== :: ListStageDevices -> ListStageDevices -> Bool
$c== :: ListStageDevices -> ListStageDevices -> Bool
Prelude.Eq, ReadPrec [ListStageDevices]
ReadPrec ListStageDevices
Int -> ReadS ListStageDevices
ReadS [ListStageDevices]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListStageDevices]
$creadListPrec :: ReadPrec [ListStageDevices]
readPrec :: ReadPrec ListStageDevices
$creadPrec :: ReadPrec ListStageDevices
readList :: ReadS [ListStageDevices]
$creadList :: ReadS [ListStageDevices]
readsPrec :: Int -> ReadS ListStageDevices
$creadsPrec :: Int -> ReadS ListStageDevices
Prelude.Read, Int -> ListStageDevices -> ShowS
[ListStageDevices] -> ShowS
ListStageDevices -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStageDevices] -> ShowS
$cshowList :: [ListStageDevices] -> ShowS
show :: ListStageDevices -> String
$cshow :: ListStageDevices -> String
showsPrec :: Int -> ListStageDevices -> ShowS
$cshowsPrec :: Int -> ListStageDevices -> ShowS
Prelude.Show, forall x. Rep ListStageDevices x -> ListStageDevices
forall x. ListStageDevices -> Rep ListStageDevices x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListStageDevices x -> ListStageDevices
$cfrom :: forall x. ListStageDevices -> Rep ListStageDevices x
Prelude.Generic)

-- |
-- Create a value of 'ListStageDevices' 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:
--
-- 'excludeDevicesDeployedInOtherStage', 'listStageDevices_excludeDevicesDeployedInOtherStage' - Toggle for excluding devices deployed in other stages.
--
-- 'maxResults', 'listStageDevices_maxResults' - The maximum number of requests to select.
--
-- 'nextToken', 'listStageDevices_nextToken' - The response from the last list when returning a list large enough to
-- neeed tokening.
--
-- 'edgeDeploymentPlanName', 'listStageDevices_edgeDeploymentPlanName' - The name of the edge deployment plan.
--
-- 'stageName', 'listStageDevices_stageName' - The name of the stage in the deployment.
newListStageDevices ::
  -- | 'edgeDeploymentPlanName'
  Prelude.Text ->
  -- | 'stageName'
  Prelude.Text ->
  ListStageDevices
newListStageDevices :: Text -> Text -> ListStageDevices
newListStageDevices
  Text
pEdgeDeploymentPlanName_
  Text
pStageName_ =
    ListStageDevices'
      { $sel:excludeDevicesDeployedInOtherStage:ListStageDevices' :: Maybe Bool
excludeDevicesDeployedInOtherStage =
          forall a. Maybe a
Prelude.Nothing,
        $sel:maxResults:ListStageDevices' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:ListStageDevices' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:edgeDeploymentPlanName:ListStageDevices' :: Text
edgeDeploymentPlanName = Text
pEdgeDeploymentPlanName_,
        $sel:stageName:ListStageDevices' :: Text
stageName = Text
pStageName_
      }

-- | Toggle for excluding devices deployed in other stages.
listStageDevices_excludeDevicesDeployedInOtherStage :: Lens.Lens' ListStageDevices (Prelude.Maybe Prelude.Bool)
listStageDevices_excludeDevicesDeployedInOtherStage :: Lens' ListStageDevices (Maybe Bool)
listStageDevices_excludeDevicesDeployedInOtherStage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStageDevices' {Maybe Bool
excludeDevicesDeployedInOtherStage :: Maybe Bool
$sel:excludeDevicesDeployedInOtherStage:ListStageDevices' :: ListStageDevices -> Maybe Bool
excludeDevicesDeployedInOtherStage} -> Maybe Bool
excludeDevicesDeployedInOtherStage) (\s :: ListStageDevices
s@ListStageDevices' {} Maybe Bool
a -> ListStageDevices
s {$sel:excludeDevicesDeployedInOtherStage:ListStageDevices' :: Maybe Bool
excludeDevicesDeployedInOtherStage = Maybe Bool
a} :: ListStageDevices)

-- | The maximum number of requests to select.
listStageDevices_maxResults :: Lens.Lens' ListStageDevices (Prelude.Maybe Prelude.Int)
listStageDevices_maxResults :: Lens' ListStageDevices (Maybe Int)
listStageDevices_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStageDevices' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ListStageDevices' :: ListStageDevices -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ListStageDevices
s@ListStageDevices' {} Maybe Int
a -> ListStageDevices
s {$sel:maxResults:ListStageDevices' :: Maybe Int
maxResults = Maybe Int
a} :: ListStageDevices)

-- | The response from the last list when returning a list large enough to
-- neeed tokening.
listStageDevices_nextToken :: Lens.Lens' ListStageDevices (Prelude.Maybe Prelude.Text)
listStageDevices_nextToken :: Lens' ListStageDevices (Maybe Text)
listStageDevices_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStageDevices' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListStageDevices' :: ListStageDevices -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListStageDevices
s@ListStageDevices' {} Maybe Text
a -> ListStageDevices
s {$sel:nextToken:ListStageDevices' :: Maybe Text
nextToken = Maybe Text
a} :: ListStageDevices)

-- | The name of the edge deployment plan.
listStageDevices_edgeDeploymentPlanName :: Lens.Lens' ListStageDevices Prelude.Text
listStageDevices_edgeDeploymentPlanName :: Lens' ListStageDevices Text
listStageDevices_edgeDeploymentPlanName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStageDevices' {Text
edgeDeploymentPlanName :: Text
$sel:edgeDeploymentPlanName:ListStageDevices' :: ListStageDevices -> Text
edgeDeploymentPlanName} -> Text
edgeDeploymentPlanName) (\s :: ListStageDevices
s@ListStageDevices' {} Text
a -> ListStageDevices
s {$sel:edgeDeploymentPlanName:ListStageDevices' :: Text
edgeDeploymentPlanName = Text
a} :: ListStageDevices)

-- | The name of the stage in the deployment.
listStageDevices_stageName :: Lens.Lens' ListStageDevices Prelude.Text
listStageDevices_stageName :: Lens' ListStageDevices Text
listStageDevices_stageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStageDevices' {Text
stageName :: Text
$sel:stageName:ListStageDevices' :: ListStageDevices -> Text
stageName} -> Text
stageName) (\s :: ListStageDevices
s@ListStageDevices' {} Text
a -> ListStageDevices
s {$sel:stageName:ListStageDevices' :: Text
stageName = Text
a} :: ListStageDevices)

instance Core.AWSPager ListStageDevices where
  page :: ListStageDevices
-> AWSResponse ListStageDevices -> Maybe ListStageDevices
page ListStageDevices
rq AWSResponse ListStageDevices
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListStageDevices
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStageDevicesResponse (Maybe Text)
listStageDevicesResponse_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 ListStageDevices
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListStageDevicesResponse [DeviceDeploymentSummary]
listStageDevicesResponse_deviceDeploymentSummaries
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListStageDevices
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListStageDevices (Maybe Text)
listStageDevices_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListStageDevices
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListStageDevicesResponse (Maybe Text)
listStageDevicesResponse_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 ListStageDevices where
  type
    AWSResponse ListStageDevices =
      ListStageDevicesResponse
  request :: (Service -> Service)
-> ListStageDevices -> Request ListStageDevices
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 ListStageDevices
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListStageDevices)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Int -> [DeviceDeploymentSummary] -> ListStageDevicesResponse
ListStageDevicesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            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
"DeviceDeploymentSummaries"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable ListStageDevices where
  hashWithSalt :: Int -> ListStageDevices -> Int
hashWithSalt Int
_salt ListStageDevices' {Maybe Bool
Maybe Int
Maybe Text
Text
stageName :: Text
edgeDeploymentPlanName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
excludeDevicesDeployedInOtherStage :: Maybe Bool
$sel:stageName:ListStageDevices' :: ListStageDevices -> Text
$sel:edgeDeploymentPlanName:ListStageDevices' :: ListStageDevices -> Text
$sel:nextToken:ListStageDevices' :: ListStageDevices -> Maybe Text
$sel:maxResults:ListStageDevices' :: ListStageDevices -> Maybe Int
$sel:excludeDevicesDeployedInOtherStage:ListStageDevices' :: ListStageDevices -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
excludeDevicesDeployedInOtherStage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
edgeDeploymentPlanName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stageName

instance Prelude.NFData ListStageDevices where
  rnf :: ListStageDevices -> ()
rnf ListStageDevices' {Maybe Bool
Maybe Int
Maybe Text
Text
stageName :: Text
edgeDeploymentPlanName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
excludeDevicesDeployedInOtherStage :: Maybe Bool
$sel:stageName:ListStageDevices' :: ListStageDevices -> Text
$sel:edgeDeploymentPlanName:ListStageDevices' :: ListStageDevices -> Text
$sel:nextToken:ListStageDevices' :: ListStageDevices -> Maybe Text
$sel:maxResults:ListStageDevices' :: ListStageDevices -> Maybe Int
$sel:excludeDevicesDeployedInOtherStage:ListStageDevices' :: ListStageDevices -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
excludeDevicesDeployedInOtherStage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
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 Text
edgeDeploymentPlanName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stageName

instance Data.ToHeaders ListStageDevices where
  toHeaders :: ListStageDevices -> 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
"SageMaker.ListStageDevices" :: 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 ListStageDevices where
  toJSON :: ListStageDevices -> Value
toJSON ListStageDevices' {Maybe Bool
Maybe Int
Maybe Text
Text
stageName :: Text
edgeDeploymentPlanName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
excludeDevicesDeployedInOtherStage :: Maybe Bool
$sel:stageName:ListStageDevices' :: ListStageDevices -> Text
$sel:edgeDeploymentPlanName:ListStageDevices' :: ListStageDevices -> Text
$sel:nextToken:ListStageDevices' :: ListStageDevices -> Maybe Text
$sel:maxResults:ListStageDevices' :: ListStageDevices -> Maybe Int
$sel:excludeDevicesDeployedInOtherStage:ListStageDevices' :: ListStageDevices -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ExcludeDevicesDeployedInOtherStage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
excludeDevicesDeployedInOtherStage,
            (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 Int
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,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"EdgeDeploymentPlanName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
edgeDeploymentPlanName
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"StageName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stageName)
          ]
      )

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

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

-- | /See:/ 'newListStageDevicesResponse' smart constructor.
data ListStageDevicesResponse = ListStageDevicesResponse'
  { -- | The token to use when calling the next page of results.
    ListStageDevicesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListStageDevicesResponse -> Int
httpStatus :: Prelude.Int,
    -- | List of summaries of devices allocated to the stage.
    ListStageDevicesResponse -> [DeviceDeploymentSummary]
deviceDeploymentSummaries :: [DeviceDeploymentSummary]
  }
  deriving (ListStageDevicesResponse -> ListStageDevicesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListStageDevicesResponse -> ListStageDevicesResponse -> Bool
$c/= :: ListStageDevicesResponse -> ListStageDevicesResponse -> Bool
== :: ListStageDevicesResponse -> ListStageDevicesResponse -> Bool
$c== :: ListStageDevicesResponse -> ListStageDevicesResponse -> Bool
Prelude.Eq, ReadPrec [ListStageDevicesResponse]
ReadPrec ListStageDevicesResponse
Int -> ReadS ListStageDevicesResponse
ReadS [ListStageDevicesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListStageDevicesResponse]
$creadListPrec :: ReadPrec [ListStageDevicesResponse]
readPrec :: ReadPrec ListStageDevicesResponse
$creadPrec :: ReadPrec ListStageDevicesResponse
readList :: ReadS [ListStageDevicesResponse]
$creadList :: ReadS [ListStageDevicesResponse]
readsPrec :: Int -> ReadS ListStageDevicesResponse
$creadsPrec :: Int -> ReadS ListStageDevicesResponse
Prelude.Read, Int -> ListStageDevicesResponse -> ShowS
[ListStageDevicesResponse] -> ShowS
ListStageDevicesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListStageDevicesResponse] -> ShowS
$cshowList :: [ListStageDevicesResponse] -> ShowS
show :: ListStageDevicesResponse -> String
$cshow :: ListStageDevicesResponse -> String
showsPrec :: Int -> ListStageDevicesResponse -> ShowS
$cshowsPrec :: Int -> ListStageDevicesResponse -> ShowS
Prelude.Show, forall x.
Rep ListStageDevicesResponse x -> ListStageDevicesResponse
forall x.
ListStageDevicesResponse -> Rep ListStageDevicesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListStageDevicesResponse x -> ListStageDevicesResponse
$cfrom :: forall x.
ListStageDevicesResponse -> Rep ListStageDevicesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListStageDevicesResponse' 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', 'listStageDevicesResponse_nextToken' - The token to use when calling the next page of results.
--
-- 'httpStatus', 'listStageDevicesResponse_httpStatus' - The response's http status code.
--
-- 'deviceDeploymentSummaries', 'listStageDevicesResponse_deviceDeploymentSummaries' - List of summaries of devices allocated to the stage.
newListStageDevicesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListStageDevicesResponse
newListStageDevicesResponse :: Int -> ListStageDevicesResponse
newListStageDevicesResponse Int
pHttpStatus_ =
  ListStageDevicesResponse'
    { $sel:nextToken:ListStageDevicesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListStageDevicesResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:deviceDeploymentSummaries:ListStageDevicesResponse' :: [DeviceDeploymentSummary]
deviceDeploymentSummaries = forall a. Monoid a => a
Prelude.mempty
    }

-- | The token to use when calling the next page of results.
listStageDevicesResponse_nextToken :: Lens.Lens' ListStageDevicesResponse (Prelude.Maybe Prelude.Text)
listStageDevicesResponse_nextToken :: Lens' ListStageDevicesResponse (Maybe Text)
listStageDevicesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStageDevicesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListStageDevicesResponse' :: ListStageDevicesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListStageDevicesResponse
s@ListStageDevicesResponse' {} Maybe Text
a -> ListStageDevicesResponse
s {$sel:nextToken:ListStageDevicesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListStageDevicesResponse)

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

-- | List of summaries of devices allocated to the stage.
listStageDevicesResponse_deviceDeploymentSummaries :: Lens.Lens' ListStageDevicesResponse [DeviceDeploymentSummary]
listStageDevicesResponse_deviceDeploymentSummaries :: Lens' ListStageDevicesResponse [DeviceDeploymentSummary]
listStageDevicesResponse_deviceDeploymentSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListStageDevicesResponse' {[DeviceDeploymentSummary]
deviceDeploymentSummaries :: [DeviceDeploymentSummary]
$sel:deviceDeploymentSummaries:ListStageDevicesResponse' :: ListStageDevicesResponse -> [DeviceDeploymentSummary]
deviceDeploymentSummaries} -> [DeviceDeploymentSummary]
deviceDeploymentSummaries) (\s :: ListStageDevicesResponse
s@ListStageDevicesResponse' {} [DeviceDeploymentSummary]
a -> ListStageDevicesResponse
s {$sel:deviceDeploymentSummaries:ListStageDevicesResponse' :: [DeviceDeploymentSummary]
deviceDeploymentSummaries = [DeviceDeploymentSummary]
a} :: ListStageDevicesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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