{-# 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.RobOMaker.ListSimulationJobs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of simulation jobs. You can optionally provide filters to
-- retrieve specific simulation jobs.
--
-- This operation returns paginated results.
module Amazonka.RobOMaker.ListSimulationJobs
  ( -- * Creating a Request
    ListSimulationJobs (..),
    newListSimulationJobs,

    -- * Request Lenses
    listSimulationJobs_filters,
    listSimulationJobs_maxResults,
    listSimulationJobs_nextToken,

    -- * Destructuring the Response
    ListSimulationJobsResponse (..),
    newListSimulationJobsResponse,

    -- * Response Lenses
    listSimulationJobsResponse_nextToken,
    listSimulationJobsResponse_httpStatus,
    listSimulationJobsResponse_simulationJobSummaries,
  )
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.RobOMaker.Types

-- | /See:/ 'newListSimulationJobs' smart constructor.
data ListSimulationJobs = ListSimulationJobs'
  { -- | Optional filters to limit results.
    --
    -- The filter names @status@ and @simulationApplicationName@ and
    -- @robotApplicationName@ are supported. When filtering, you must use the
    -- complete value of the filtered item. You can use up to three filters,
    -- but they must be for the same named item. For example, if you are
    -- looking for items with the status @Preparing@ or the status @Running@.
    ListSimulationJobs -> Maybe (NonEmpty Filter)
filters :: Prelude.Maybe (Prelude.NonEmpty Filter),
    -- | When this parameter is used, @ListSimulationJobs@ only returns
    -- @maxResults@ results in a single page along with a @nextToken@ response
    -- element. The remaining results of the initial request can be seen by
    -- sending another @ListSimulationJobs@ request with the returned
    -- @nextToken@ value. This value can be between 1 and 1000. If this
    -- parameter is not used, then @ListSimulationJobs@ returns up to 1000
    -- results and a @nextToken@ value if applicable.
    ListSimulationJobs -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | If the previous paginated request did not return all of the remaining
    -- results, the response object\'s @nextToken@ parameter value is set to a
    -- token. To retrieve the next set of results, call @ListSimulationJobs@
    -- again and assign that token to the request object\'s @nextToken@
    -- parameter. If there are no remaining results, the previous response
    -- object\'s NextToken parameter is set to null.
    ListSimulationJobs -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListSimulationJobs -> ListSimulationJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSimulationJobs -> ListSimulationJobs -> Bool
$c/= :: ListSimulationJobs -> ListSimulationJobs -> Bool
== :: ListSimulationJobs -> ListSimulationJobs -> Bool
$c== :: ListSimulationJobs -> ListSimulationJobs -> Bool
Prelude.Eq, ReadPrec [ListSimulationJobs]
ReadPrec ListSimulationJobs
Int -> ReadS ListSimulationJobs
ReadS [ListSimulationJobs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSimulationJobs]
$creadListPrec :: ReadPrec [ListSimulationJobs]
readPrec :: ReadPrec ListSimulationJobs
$creadPrec :: ReadPrec ListSimulationJobs
readList :: ReadS [ListSimulationJobs]
$creadList :: ReadS [ListSimulationJobs]
readsPrec :: Int -> ReadS ListSimulationJobs
$creadsPrec :: Int -> ReadS ListSimulationJobs
Prelude.Read, Int -> ListSimulationJobs -> ShowS
[ListSimulationJobs] -> ShowS
ListSimulationJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSimulationJobs] -> ShowS
$cshowList :: [ListSimulationJobs] -> ShowS
show :: ListSimulationJobs -> String
$cshow :: ListSimulationJobs -> String
showsPrec :: Int -> ListSimulationJobs -> ShowS
$cshowsPrec :: Int -> ListSimulationJobs -> ShowS
Prelude.Show, forall x. Rep ListSimulationJobs x -> ListSimulationJobs
forall x. ListSimulationJobs -> Rep ListSimulationJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListSimulationJobs x -> ListSimulationJobs
$cfrom :: forall x. ListSimulationJobs -> Rep ListSimulationJobs x
Prelude.Generic)

-- |
-- Create a value of 'ListSimulationJobs' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'filters', 'listSimulationJobs_filters' - Optional filters to limit results.
--
-- The filter names @status@ and @simulationApplicationName@ and
-- @robotApplicationName@ are supported. When filtering, you must use the
-- complete value of the filtered item. You can use up to three filters,
-- but they must be for the same named item. For example, if you are
-- looking for items with the status @Preparing@ or the status @Running@.
--
-- 'maxResults', 'listSimulationJobs_maxResults' - When this parameter is used, @ListSimulationJobs@ only returns
-- @maxResults@ results in a single page along with a @nextToken@ response
-- element. The remaining results of the initial request can be seen by
-- sending another @ListSimulationJobs@ request with the returned
-- @nextToken@ value. This value can be between 1 and 1000. If this
-- parameter is not used, then @ListSimulationJobs@ returns up to 1000
-- results and a @nextToken@ value if applicable.
--
-- 'nextToken', 'listSimulationJobs_nextToken' - If the previous paginated request did not return all of the remaining
-- results, the response object\'s @nextToken@ parameter value is set to a
-- token. To retrieve the next set of results, call @ListSimulationJobs@
-- again and assign that token to the request object\'s @nextToken@
-- parameter. If there are no remaining results, the previous response
-- object\'s NextToken parameter is set to null.
newListSimulationJobs ::
  ListSimulationJobs
newListSimulationJobs :: ListSimulationJobs
newListSimulationJobs =
  ListSimulationJobs'
    { $sel:filters:ListSimulationJobs' :: Maybe (NonEmpty Filter)
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListSimulationJobs' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListSimulationJobs' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | Optional filters to limit results.
--
-- The filter names @status@ and @simulationApplicationName@ and
-- @robotApplicationName@ are supported. When filtering, you must use the
-- complete value of the filtered item. You can use up to three filters,
-- but they must be for the same named item. For example, if you are
-- looking for items with the status @Preparing@ or the status @Running@.
listSimulationJobs_filters :: Lens.Lens' ListSimulationJobs (Prelude.Maybe (Prelude.NonEmpty Filter))
listSimulationJobs_filters :: Lens' ListSimulationJobs (Maybe (NonEmpty Filter))
listSimulationJobs_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSimulationJobs' {Maybe (NonEmpty Filter)
filters :: Maybe (NonEmpty Filter)
$sel:filters:ListSimulationJobs' :: ListSimulationJobs -> Maybe (NonEmpty Filter)
filters} -> Maybe (NonEmpty Filter)
filters) (\s :: ListSimulationJobs
s@ListSimulationJobs' {} Maybe (NonEmpty Filter)
a -> ListSimulationJobs
s {$sel:filters:ListSimulationJobs' :: Maybe (NonEmpty Filter)
filters = Maybe (NonEmpty Filter)
a} :: ListSimulationJobs) 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

-- | When this parameter is used, @ListSimulationJobs@ only returns
-- @maxResults@ results in a single page along with a @nextToken@ response
-- element. The remaining results of the initial request can be seen by
-- sending another @ListSimulationJobs@ request with the returned
-- @nextToken@ value. This value can be between 1 and 1000. If this
-- parameter is not used, then @ListSimulationJobs@ returns up to 1000
-- results and a @nextToken@ value if applicable.
listSimulationJobs_maxResults :: Lens.Lens' ListSimulationJobs (Prelude.Maybe Prelude.Int)
listSimulationJobs_maxResults :: Lens' ListSimulationJobs (Maybe Int)
listSimulationJobs_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSimulationJobs' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ListSimulationJobs' :: ListSimulationJobs -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ListSimulationJobs
s@ListSimulationJobs' {} Maybe Int
a -> ListSimulationJobs
s {$sel:maxResults:ListSimulationJobs' :: Maybe Int
maxResults = Maybe Int
a} :: ListSimulationJobs)

-- | If the previous paginated request did not return all of the remaining
-- results, the response object\'s @nextToken@ parameter value is set to a
-- token. To retrieve the next set of results, call @ListSimulationJobs@
-- again and assign that token to the request object\'s @nextToken@
-- parameter. If there are no remaining results, the previous response
-- object\'s NextToken parameter is set to null.
listSimulationJobs_nextToken :: Lens.Lens' ListSimulationJobs (Prelude.Maybe Prelude.Text)
listSimulationJobs_nextToken :: Lens' ListSimulationJobs (Maybe Text)
listSimulationJobs_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSimulationJobs' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSimulationJobs' :: ListSimulationJobs -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSimulationJobs
s@ListSimulationJobs' {} Maybe Text
a -> ListSimulationJobs
s {$sel:nextToken:ListSimulationJobs' :: Maybe Text
nextToken = Maybe Text
a} :: ListSimulationJobs)

instance Core.AWSPager ListSimulationJobs where
  page :: ListSimulationJobs
-> AWSResponse ListSimulationJobs -> Maybe ListSimulationJobs
page ListSimulationJobs
rq AWSResponse ListSimulationJobs
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListSimulationJobs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSimulationJobsResponse (Maybe Text)
listSimulationJobsResponse_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 ListSimulationJobs
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListSimulationJobsResponse [SimulationJobSummary]
listSimulationJobsResponse_simulationJobSummaries
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListSimulationJobs
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListSimulationJobs (Maybe Text)
listSimulationJobs_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListSimulationJobs
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSimulationJobsResponse (Maybe Text)
listSimulationJobsResponse_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 ListSimulationJobs where
  type
    AWSResponse ListSimulationJobs =
      ListSimulationJobsResponse
  request :: (Service -> Service)
-> ListSimulationJobs -> Request ListSimulationJobs
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 ListSimulationJobs
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListSimulationJobs)))
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 -> [SimulationJobSummary] -> ListSimulationJobsResponse
ListSimulationJobsResponse'
            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
"simulationJobSummaries"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable ListSimulationJobs where
  hashWithSalt :: Int -> ListSimulationJobs -> Int
hashWithSalt Int
_salt ListSimulationJobs' {Maybe Int
Maybe (NonEmpty Filter)
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe (NonEmpty Filter)
$sel:nextToken:ListSimulationJobs' :: ListSimulationJobs -> Maybe Text
$sel:maxResults:ListSimulationJobs' :: ListSimulationJobs -> Maybe Int
$sel:filters:ListSimulationJobs' :: ListSimulationJobs -> Maybe (NonEmpty Filter)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Filter)
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListSimulationJobs where
  rnf :: ListSimulationJobs -> ()
rnf ListSimulationJobs' {Maybe Int
Maybe (NonEmpty Filter)
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe (NonEmpty Filter)
$sel:nextToken:ListSimulationJobs' :: ListSimulationJobs -> Maybe Text
$sel:maxResults:ListSimulationJobs' :: ListSimulationJobs -> Maybe Int
$sel:filters:ListSimulationJobs' :: ListSimulationJobs -> Maybe (NonEmpty Filter)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Filter)
filters
      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

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

instance Data.ToJSON ListSimulationJobs where
  toJSON :: ListSimulationJobs -> Value
toJSON ListSimulationJobs' {Maybe Int
Maybe (NonEmpty Filter)
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe (NonEmpty Filter)
$sel:nextToken:ListSimulationJobs' :: ListSimulationJobs -> Maybe Text
$sel:maxResults:ListSimulationJobs' :: ListSimulationJobs -> Maybe Int
$sel:filters:ListSimulationJobs' :: ListSimulationJobs -> Maybe (NonEmpty Filter)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"filters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Filter)
filters,
            (Key
"maxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe 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
          ]
      )

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

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

-- | /See:/ 'newListSimulationJobsResponse' smart constructor.
data ListSimulationJobsResponse = ListSimulationJobsResponse'
  { -- | If the previous paginated request did not return all of the remaining
    -- results, the response object\'s @nextToken@ parameter value is set to a
    -- token. To retrieve the next set of results, call @ListSimulationJobs@
    -- again and assign that token to the request object\'s @nextToken@
    -- parameter. If there are no remaining results, the previous response
    -- object\'s NextToken parameter is set to null.
    ListSimulationJobsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListSimulationJobsResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of simulation job summaries that meet the criteria of the
    -- request.
    ListSimulationJobsResponse -> [SimulationJobSummary]
simulationJobSummaries :: [SimulationJobSummary]
  }
  deriving (ListSimulationJobsResponse -> ListSimulationJobsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSimulationJobsResponse -> ListSimulationJobsResponse -> Bool
$c/= :: ListSimulationJobsResponse -> ListSimulationJobsResponse -> Bool
== :: ListSimulationJobsResponse -> ListSimulationJobsResponse -> Bool
$c== :: ListSimulationJobsResponse -> ListSimulationJobsResponse -> Bool
Prelude.Eq, ReadPrec [ListSimulationJobsResponse]
ReadPrec ListSimulationJobsResponse
Int -> ReadS ListSimulationJobsResponse
ReadS [ListSimulationJobsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSimulationJobsResponse]
$creadListPrec :: ReadPrec [ListSimulationJobsResponse]
readPrec :: ReadPrec ListSimulationJobsResponse
$creadPrec :: ReadPrec ListSimulationJobsResponse
readList :: ReadS [ListSimulationJobsResponse]
$creadList :: ReadS [ListSimulationJobsResponse]
readsPrec :: Int -> ReadS ListSimulationJobsResponse
$creadsPrec :: Int -> ReadS ListSimulationJobsResponse
Prelude.Read, Int -> ListSimulationJobsResponse -> ShowS
[ListSimulationJobsResponse] -> ShowS
ListSimulationJobsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSimulationJobsResponse] -> ShowS
$cshowList :: [ListSimulationJobsResponse] -> ShowS
show :: ListSimulationJobsResponse -> String
$cshow :: ListSimulationJobsResponse -> String
showsPrec :: Int -> ListSimulationJobsResponse -> ShowS
$cshowsPrec :: Int -> ListSimulationJobsResponse -> ShowS
Prelude.Show, forall x.
Rep ListSimulationJobsResponse x -> ListSimulationJobsResponse
forall x.
ListSimulationJobsResponse -> Rep ListSimulationJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListSimulationJobsResponse x -> ListSimulationJobsResponse
$cfrom :: forall x.
ListSimulationJobsResponse -> Rep ListSimulationJobsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListSimulationJobsResponse' 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', 'listSimulationJobsResponse_nextToken' - If the previous paginated request did not return all of the remaining
-- results, the response object\'s @nextToken@ parameter value is set to a
-- token. To retrieve the next set of results, call @ListSimulationJobs@
-- again and assign that token to the request object\'s @nextToken@
-- parameter. If there are no remaining results, the previous response
-- object\'s NextToken parameter is set to null.
--
-- 'httpStatus', 'listSimulationJobsResponse_httpStatus' - The response's http status code.
--
-- 'simulationJobSummaries', 'listSimulationJobsResponse_simulationJobSummaries' - A list of simulation job summaries that meet the criteria of the
-- request.
newListSimulationJobsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListSimulationJobsResponse
newListSimulationJobsResponse :: Int -> ListSimulationJobsResponse
newListSimulationJobsResponse Int
pHttpStatus_ =
  ListSimulationJobsResponse'
    { $sel:nextToken:ListSimulationJobsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListSimulationJobsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:simulationJobSummaries:ListSimulationJobsResponse' :: [SimulationJobSummary]
simulationJobSummaries = forall a. Monoid a => a
Prelude.mempty
    }

-- | If the previous paginated request did not return all of the remaining
-- results, the response object\'s @nextToken@ parameter value is set to a
-- token. To retrieve the next set of results, call @ListSimulationJobs@
-- again and assign that token to the request object\'s @nextToken@
-- parameter. If there are no remaining results, the previous response
-- object\'s NextToken parameter is set to null.
listSimulationJobsResponse_nextToken :: Lens.Lens' ListSimulationJobsResponse (Prelude.Maybe Prelude.Text)
listSimulationJobsResponse_nextToken :: Lens' ListSimulationJobsResponse (Maybe Text)
listSimulationJobsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSimulationJobsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSimulationJobsResponse' :: ListSimulationJobsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSimulationJobsResponse
s@ListSimulationJobsResponse' {} Maybe Text
a -> ListSimulationJobsResponse
s {$sel:nextToken:ListSimulationJobsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListSimulationJobsResponse)

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

-- | A list of simulation job summaries that meet the criteria of the
-- request.
listSimulationJobsResponse_simulationJobSummaries :: Lens.Lens' ListSimulationJobsResponse [SimulationJobSummary]
listSimulationJobsResponse_simulationJobSummaries :: Lens' ListSimulationJobsResponse [SimulationJobSummary]
listSimulationJobsResponse_simulationJobSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSimulationJobsResponse' {[SimulationJobSummary]
simulationJobSummaries :: [SimulationJobSummary]
$sel:simulationJobSummaries:ListSimulationJobsResponse' :: ListSimulationJobsResponse -> [SimulationJobSummary]
simulationJobSummaries} -> [SimulationJobSummary]
simulationJobSummaries) (\s :: ListSimulationJobsResponse
s@ListSimulationJobsResponse' {} [SimulationJobSummary]
a -> ListSimulationJobsResponse
s {$sel:simulationJobSummaries:ListSimulationJobsResponse' :: [SimulationJobSummary]
simulationJobSummaries = [SimulationJobSummary]
a} :: ListSimulationJobsResponse) 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 ListSimulationJobsResponse where
  rnf :: ListSimulationJobsResponse -> ()
rnf ListSimulationJobsResponse' {Int
[SimulationJobSummary]
Maybe Text
simulationJobSummaries :: [SimulationJobSummary]
httpStatus :: Int
nextToken :: Maybe Text
$sel:simulationJobSummaries:ListSimulationJobsResponse' :: ListSimulationJobsResponse -> [SimulationJobSummary]
$sel:httpStatus:ListSimulationJobsResponse' :: ListSimulationJobsResponse -> Int
$sel:nextToken:ListSimulationJobsResponse' :: ListSimulationJobsResponse -> 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 [SimulationJobSummary]
simulationJobSummaries