{-# 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.MigrationHubOrchestrator.ListTemplateSteps
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List the steps in a template.
--
-- This operation returns paginated results.
module Amazonka.MigrationHubOrchestrator.ListTemplateSteps
  ( -- * Creating a Request
    ListTemplateSteps (..),
    newListTemplateSteps,

    -- * Request Lenses
    listTemplateSteps_maxResults,
    listTemplateSteps_nextToken,
    listTemplateSteps_templateId,
    listTemplateSteps_stepGroupId,

    -- * Destructuring the Response
    ListTemplateStepsResponse (..),
    newListTemplateStepsResponse,

    -- * Response Lenses
    listTemplateStepsResponse_nextToken,
    listTemplateStepsResponse_templateStepSummaryList,
    listTemplateStepsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListTemplateSteps' smart constructor.
data ListTemplateSteps = ListTemplateSteps'
  { -- | The maximum number of results that can be returned.
    ListTemplateSteps -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The pagination token.
    ListTemplateSteps -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the template.
    ListTemplateSteps -> Text
templateId :: Prelude.Text,
    -- | The ID of the step group.
    ListTemplateSteps -> Text
stepGroupId :: Prelude.Text
  }
  deriving (ListTemplateSteps -> ListTemplateSteps -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTemplateSteps -> ListTemplateSteps -> Bool
$c/= :: ListTemplateSteps -> ListTemplateSteps -> Bool
== :: ListTemplateSteps -> ListTemplateSteps -> Bool
$c== :: ListTemplateSteps -> ListTemplateSteps -> Bool
Prelude.Eq, ReadPrec [ListTemplateSteps]
ReadPrec ListTemplateSteps
Int -> ReadS ListTemplateSteps
ReadS [ListTemplateSteps]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTemplateSteps]
$creadListPrec :: ReadPrec [ListTemplateSteps]
readPrec :: ReadPrec ListTemplateSteps
$creadPrec :: ReadPrec ListTemplateSteps
readList :: ReadS [ListTemplateSteps]
$creadList :: ReadS [ListTemplateSteps]
readsPrec :: Int -> ReadS ListTemplateSteps
$creadsPrec :: Int -> ReadS ListTemplateSteps
Prelude.Read, Int -> ListTemplateSteps -> ShowS
[ListTemplateSteps] -> ShowS
ListTemplateSteps -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTemplateSteps] -> ShowS
$cshowList :: [ListTemplateSteps] -> ShowS
show :: ListTemplateSteps -> String
$cshow :: ListTemplateSteps -> String
showsPrec :: Int -> ListTemplateSteps -> ShowS
$cshowsPrec :: Int -> ListTemplateSteps -> ShowS
Prelude.Show, forall x. Rep ListTemplateSteps x -> ListTemplateSteps
forall x. ListTemplateSteps -> Rep ListTemplateSteps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTemplateSteps x -> ListTemplateSteps
$cfrom :: forall x. ListTemplateSteps -> Rep ListTemplateSteps x
Prelude.Generic)

-- |
-- Create a value of 'ListTemplateSteps' 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', 'listTemplateSteps_maxResults' - The maximum number of results that can be returned.
--
-- 'nextToken', 'listTemplateSteps_nextToken' - The pagination token.
--
-- 'templateId', 'listTemplateSteps_templateId' - The ID of the template.
--
-- 'stepGroupId', 'listTemplateSteps_stepGroupId' - The ID of the step group.
newListTemplateSteps ::
  -- | 'templateId'
  Prelude.Text ->
  -- | 'stepGroupId'
  Prelude.Text ->
  ListTemplateSteps
newListTemplateSteps :: Text -> Text -> ListTemplateSteps
newListTemplateSteps Text
pTemplateId_ Text
pStepGroupId_ =
  ListTemplateSteps'
    { $sel:maxResults:ListTemplateSteps' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListTemplateSteps' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:templateId:ListTemplateSteps' :: Text
templateId = Text
pTemplateId_,
      $sel:stepGroupId:ListTemplateSteps' :: Text
stepGroupId = Text
pStepGroupId_
    }

-- | The maximum number of results that can be returned.
listTemplateSteps_maxResults :: Lens.Lens' ListTemplateSteps (Prelude.Maybe Prelude.Natural)
listTemplateSteps_maxResults :: Lens' ListTemplateSteps (Maybe Natural)
listTemplateSteps_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateSteps' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListTemplateSteps' :: ListTemplateSteps -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListTemplateSteps
s@ListTemplateSteps' {} Maybe Natural
a -> ListTemplateSteps
s {$sel:maxResults:ListTemplateSteps' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListTemplateSteps)

-- | The pagination token.
listTemplateSteps_nextToken :: Lens.Lens' ListTemplateSteps (Prelude.Maybe Prelude.Text)
listTemplateSteps_nextToken :: Lens' ListTemplateSteps (Maybe Text)
listTemplateSteps_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateSteps' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTemplateSteps' :: ListTemplateSteps -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTemplateSteps
s@ListTemplateSteps' {} Maybe Text
a -> ListTemplateSteps
s {$sel:nextToken:ListTemplateSteps' :: Maybe Text
nextToken = Maybe Text
a} :: ListTemplateSteps)

-- | The ID of the template.
listTemplateSteps_templateId :: Lens.Lens' ListTemplateSteps Prelude.Text
listTemplateSteps_templateId :: Lens' ListTemplateSteps Text
listTemplateSteps_templateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateSteps' {Text
templateId :: Text
$sel:templateId:ListTemplateSteps' :: ListTemplateSteps -> Text
templateId} -> Text
templateId) (\s :: ListTemplateSteps
s@ListTemplateSteps' {} Text
a -> ListTemplateSteps
s {$sel:templateId:ListTemplateSteps' :: Text
templateId = Text
a} :: ListTemplateSteps)

-- | The ID of the step group.
listTemplateSteps_stepGroupId :: Lens.Lens' ListTemplateSteps Prelude.Text
listTemplateSteps_stepGroupId :: Lens' ListTemplateSteps Text
listTemplateSteps_stepGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateSteps' {Text
stepGroupId :: Text
$sel:stepGroupId:ListTemplateSteps' :: ListTemplateSteps -> Text
stepGroupId} -> Text
stepGroupId) (\s :: ListTemplateSteps
s@ListTemplateSteps' {} Text
a -> ListTemplateSteps
s {$sel:stepGroupId:ListTemplateSteps' :: Text
stepGroupId = Text
a} :: ListTemplateSteps)

instance Core.AWSPager ListTemplateSteps where
  page :: ListTemplateSteps
-> AWSResponse ListTemplateSteps -> Maybe ListTemplateSteps
page ListTemplateSteps
rq AWSResponse ListTemplateSteps
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTemplateSteps
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTemplateStepsResponse (Maybe Text)
listTemplateStepsResponse_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 ListTemplateSteps
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTemplateStepsResponse (Maybe [TemplateStepSummary])
listTemplateStepsResponse_templateStepSummaryList
            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.$ ListTemplateSteps
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListTemplateSteps (Maybe Text)
listTemplateSteps_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListTemplateSteps
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTemplateStepsResponse (Maybe Text)
listTemplateStepsResponse_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 ListTemplateSteps where
  type
    AWSResponse ListTemplateSteps =
      ListTemplateStepsResponse
  request :: (Service -> Service)
-> ListTemplateSteps -> Request ListTemplateSteps
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 ListTemplateSteps
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListTemplateSteps)))
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
-> Maybe [TemplateStepSummary] -> Int -> ListTemplateStepsResponse
ListTemplateStepsResponse'
            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.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"templateStepSummaryList"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListTemplateSteps where
  hashWithSalt :: Int -> ListTemplateSteps -> Int
hashWithSalt Int
_salt ListTemplateSteps' {Maybe Natural
Maybe Text
Text
stepGroupId :: Text
templateId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:stepGroupId:ListTemplateSteps' :: ListTemplateSteps -> Text
$sel:templateId:ListTemplateSteps' :: ListTemplateSteps -> Text
$sel:nextToken:ListTemplateSteps' :: ListTemplateSteps -> Maybe Text
$sel:maxResults:ListTemplateSteps' :: ListTemplateSteps -> 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` Text
templateId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stepGroupId

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

instance Data.ToHeaders ListTemplateSteps where
  toHeaders :: ListTemplateSteps -> 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.ToPath ListTemplateSteps where
  toPath :: ListTemplateSteps -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/templatesteps"

instance Data.ToQuery ListTemplateSteps where
  toQuery :: ListTemplateSteps -> QueryString
toQuery ListTemplateSteps' {Maybe Natural
Maybe Text
Text
stepGroupId :: Text
templateId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:stepGroupId:ListTemplateSteps' :: ListTemplateSteps -> Text
$sel:templateId:ListTemplateSteps' :: ListTemplateSteps -> Text
$sel:nextToken:ListTemplateSteps' :: ListTemplateSteps -> Maybe Text
$sel:maxResults:ListTemplateSteps' :: ListTemplateSteps -> 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
"templateId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
templateId,
        ByteString
"stepGroupId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stepGroupId
      ]

-- | /See:/ 'newListTemplateStepsResponse' smart constructor.
data ListTemplateStepsResponse = ListTemplateStepsResponse'
  { -- | The pagination token.
    ListTemplateStepsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The list of summaries of steps in a template.
    ListTemplateStepsResponse -> Maybe [TemplateStepSummary]
templateStepSummaryList :: Prelude.Maybe [TemplateStepSummary],
    -- | The response's http status code.
    ListTemplateStepsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListTemplateStepsResponse -> ListTemplateStepsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTemplateStepsResponse -> ListTemplateStepsResponse -> Bool
$c/= :: ListTemplateStepsResponse -> ListTemplateStepsResponse -> Bool
== :: ListTemplateStepsResponse -> ListTemplateStepsResponse -> Bool
$c== :: ListTemplateStepsResponse -> ListTemplateStepsResponse -> Bool
Prelude.Eq, ReadPrec [ListTemplateStepsResponse]
ReadPrec ListTemplateStepsResponse
Int -> ReadS ListTemplateStepsResponse
ReadS [ListTemplateStepsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTemplateStepsResponse]
$creadListPrec :: ReadPrec [ListTemplateStepsResponse]
readPrec :: ReadPrec ListTemplateStepsResponse
$creadPrec :: ReadPrec ListTemplateStepsResponse
readList :: ReadS [ListTemplateStepsResponse]
$creadList :: ReadS [ListTemplateStepsResponse]
readsPrec :: Int -> ReadS ListTemplateStepsResponse
$creadsPrec :: Int -> ReadS ListTemplateStepsResponse
Prelude.Read, Int -> ListTemplateStepsResponse -> ShowS
[ListTemplateStepsResponse] -> ShowS
ListTemplateStepsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTemplateStepsResponse] -> ShowS
$cshowList :: [ListTemplateStepsResponse] -> ShowS
show :: ListTemplateStepsResponse -> String
$cshow :: ListTemplateStepsResponse -> String
showsPrec :: Int -> ListTemplateStepsResponse -> ShowS
$cshowsPrec :: Int -> ListTemplateStepsResponse -> ShowS
Prelude.Show, forall x.
Rep ListTemplateStepsResponse x -> ListTemplateStepsResponse
forall x.
ListTemplateStepsResponse -> Rep ListTemplateStepsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListTemplateStepsResponse x -> ListTemplateStepsResponse
$cfrom :: forall x.
ListTemplateStepsResponse -> Rep ListTemplateStepsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListTemplateStepsResponse' 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', 'listTemplateStepsResponse_nextToken' - The pagination token.
--
-- 'templateStepSummaryList', 'listTemplateStepsResponse_templateStepSummaryList' - The list of summaries of steps in a template.
--
-- 'httpStatus', 'listTemplateStepsResponse_httpStatus' - The response's http status code.
newListTemplateStepsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListTemplateStepsResponse
newListTemplateStepsResponse :: Int -> ListTemplateStepsResponse
newListTemplateStepsResponse Int
pHttpStatus_ =
  ListTemplateStepsResponse'
    { $sel:nextToken:ListTemplateStepsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:templateStepSummaryList:ListTemplateStepsResponse' :: Maybe [TemplateStepSummary]
templateStepSummaryList = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListTemplateStepsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The pagination token.
listTemplateStepsResponse_nextToken :: Lens.Lens' ListTemplateStepsResponse (Prelude.Maybe Prelude.Text)
listTemplateStepsResponse_nextToken :: Lens' ListTemplateStepsResponse (Maybe Text)
listTemplateStepsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateStepsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTemplateStepsResponse' :: ListTemplateStepsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTemplateStepsResponse
s@ListTemplateStepsResponse' {} Maybe Text
a -> ListTemplateStepsResponse
s {$sel:nextToken:ListTemplateStepsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListTemplateStepsResponse)

-- | The list of summaries of steps in a template.
listTemplateStepsResponse_templateStepSummaryList :: Lens.Lens' ListTemplateStepsResponse (Prelude.Maybe [TemplateStepSummary])
listTemplateStepsResponse_templateStepSummaryList :: Lens' ListTemplateStepsResponse (Maybe [TemplateStepSummary])
listTemplateStepsResponse_templateStepSummaryList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateStepsResponse' {Maybe [TemplateStepSummary]
templateStepSummaryList :: Maybe [TemplateStepSummary]
$sel:templateStepSummaryList:ListTemplateStepsResponse' :: ListTemplateStepsResponse -> Maybe [TemplateStepSummary]
templateStepSummaryList} -> Maybe [TemplateStepSummary]
templateStepSummaryList) (\s :: ListTemplateStepsResponse
s@ListTemplateStepsResponse' {} Maybe [TemplateStepSummary]
a -> ListTemplateStepsResponse
s {$sel:templateStepSummaryList:ListTemplateStepsResponse' :: Maybe [TemplateStepSummary]
templateStepSummaryList = Maybe [TemplateStepSummary]
a} :: ListTemplateStepsResponse) 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 response's http status code.
listTemplateStepsResponse_httpStatus :: Lens.Lens' ListTemplateStepsResponse Prelude.Int
listTemplateStepsResponse_httpStatus :: Lens' ListTemplateStepsResponse Int
listTemplateStepsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateStepsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListTemplateStepsResponse' :: ListTemplateStepsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListTemplateStepsResponse
s@ListTemplateStepsResponse' {} Int
a -> ListTemplateStepsResponse
s {$sel:httpStatus:ListTemplateStepsResponse' :: Int
httpStatus = Int
a} :: ListTemplateStepsResponse)

instance Prelude.NFData ListTemplateStepsResponse where
  rnf :: ListTemplateStepsResponse -> ()
rnf ListTemplateStepsResponse' {Int
Maybe [TemplateStepSummary]
Maybe Text
httpStatus :: Int
templateStepSummaryList :: Maybe [TemplateStepSummary]
nextToken :: Maybe Text
$sel:httpStatus:ListTemplateStepsResponse' :: ListTemplateStepsResponse -> Int
$sel:templateStepSummaryList:ListTemplateStepsResponse' :: ListTemplateStepsResponse -> Maybe [TemplateStepSummary]
$sel:nextToken:ListTemplateStepsResponse' :: ListTemplateStepsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TemplateStepSummary]
templateStepSummaryList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus