{-# 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.MGN.ListTemplateActions
-- 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 template post migration custom actions.
--
-- This operation returns paginated results.
module Amazonka.MGN.ListTemplateActions
  ( -- * Creating a Request
    ListTemplateActions (..),
    newListTemplateActions,

    -- * Request Lenses
    listTemplateActions_filters,
    listTemplateActions_maxResults,
    listTemplateActions_nextToken,
    listTemplateActions_launchConfigurationTemplateID,

    -- * Destructuring the Response
    ListTemplateActionsResponse (..),
    newListTemplateActionsResponse,

    -- * Response Lenses
    listTemplateActionsResponse_items,
    listTemplateActionsResponse_nextToken,
    listTemplateActionsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListTemplateActions' smart constructor.
data ListTemplateActions = ListTemplateActions'
  { -- | Filters to apply when listing template post migration custom actions.
    ListTemplateActions -> Maybe TemplateActionsRequestFilters
filters :: Prelude.Maybe TemplateActionsRequestFilters,
    -- | Maximum amount of items to return when listing template post migration
    -- custom actions.
    ListTemplateActions -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Next token to use when listing template post migration custom actions.
    ListTemplateActions -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Launch configuration template ID.
    ListTemplateActions -> Text
launchConfigurationTemplateID :: Prelude.Text
  }
  deriving (ListTemplateActions -> ListTemplateActions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTemplateActions -> ListTemplateActions -> Bool
$c/= :: ListTemplateActions -> ListTemplateActions -> Bool
== :: ListTemplateActions -> ListTemplateActions -> Bool
$c== :: ListTemplateActions -> ListTemplateActions -> Bool
Prelude.Eq, ReadPrec [ListTemplateActions]
ReadPrec ListTemplateActions
Int -> ReadS ListTemplateActions
ReadS [ListTemplateActions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTemplateActions]
$creadListPrec :: ReadPrec [ListTemplateActions]
readPrec :: ReadPrec ListTemplateActions
$creadPrec :: ReadPrec ListTemplateActions
readList :: ReadS [ListTemplateActions]
$creadList :: ReadS [ListTemplateActions]
readsPrec :: Int -> ReadS ListTemplateActions
$creadsPrec :: Int -> ReadS ListTemplateActions
Prelude.Read, Int -> ListTemplateActions -> ShowS
[ListTemplateActions] -> ShowS
ListTemplateActions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTemplateActions] -> ShowS
$cshowList :: [ListTemplateActions] -> ShowS
show :: ListTemplateActions -> String
$cshow :: ListTemplateActions -> String
showsPrec :: Int -> ListTemplateActions -> ShowS
$cshowsPrec :: Int -> ListTemplateActions -> ShowS
Prelude.Show, forall x. Rep ListTemplateActions x -> ListTemplateActions
forall x. ListTemplateActions -> Rep ListTemplateActions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTemplateActions x -> ListTemplateActions
$cfrom :: forall x. ListTemplateActions -> Rep ListTemplateActions x
Prelude.Generic)

-- |
-- Create a value of 'ListTemplateActions' 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', 'listTemplateActions_filters' - Filters to apply when listing template post migration custom actions.
--
-- 'maxResults', 'listTemplateActions_maxResults' - Maximum amount of items to return when listing template post migration
-- custom actions.
--
-- 'nextToken', 'listTemplateActions_nextToken' - Next token to use when listing template post migration custom actions.
--
-- 'launchConfigurationTemplateID', 'listTemplateActions_launchConfigurationTemplateID' - Launch configuration template ID.
newListTemplateActions ::
  -- | 'launchConfigurationTemplateID'
  Prelude.Text ->
  ListTemplateActions
newListTemplateActions :: Text -> ListTemplateActions
newListTemplateActions
  Text
pLaunchConfigurationTemplateID_ =
    ListTemplateActions'
      { $sel:filters:ListTemplateActions' :: Maybe TemplateActionsRequestFilters
filters = forall a. Maybe a
Prelude.Nothing,
        $sel:maxResults:ListTemplateActions' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:ListTemplateActions' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:launchConfigurationTemplateID:ListTemplateActions' :: Text
launchConfigurationTemplateID =
          Text
pLaunchConfigurationTemplateID_
      }

-- | Filters to apply when listing template post migration custom actions.
listTemplateActions_filters :: Lens.Lens' ListTemplateActions (Prelude.Maybe TemplateActionsRequestFilters)
listTemplateActions_filters :: Lens' ListTemplateActions (Maybe TemplateActionsRequestFilters)
listTemplateActions_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateActions' {Maybe TemplateActionsRequestFilters
filters :: Maybe TemplateActionsRequestFilters
$sel:filters:ListTemplateActions' :: ListTemplateActions -> Maybe TemplateActionsRequestFilters
filters} -> Maybe TemplateActionsRequestFilters
filters) (\s :: ListTemplateActions
s@ListTemplateActions' {} Maybe TemplateActionsRequestFilters
a -> ListTemplateActions
s {$sel:filters:ListTemplateActions' :: Maybe TemplateActionsRequestFilters
filters = Maybe TemplateActionsRequestFilters
a} :: ListTemplateActions)

-- | Maximum amount of items to return when listing template post migration
-- custom actions.
listTemplateActions_maxResults :: Lens.Lens' ListTemplateActions (Prelude.Maybe Prelude.Natural)
listTemplateActions_maxResults :: Lens' ListTemplateActions (Maybe Natural)
listTemplateActions_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateActions' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListTemplateActions' :: ListTemplateActions -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListTemplateActions
s@ListTemplateActions' {} Maybe Natural
a -> ListTemplateActions
s {$sel:maxResults:ListTemplateActions' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListTemplateActions)

-- | Next token to use when listing template post migration custom actions.
listTemplateActions_nextToken :: Lens.Lens' ListTemplateActions (Prelude.Maybe Prelude.Text)
listTemplateActions_nextToken :: Lens' ListTemplateActions (Maybe Text)
listTemplateActions_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateActions' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTemplateActions' :: ListTemplateActions -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTemplateActions
s@ListTemplateActions' {} Maybe Text
a -> ListTemplateActions
s {$sel:nextToken:ListTemplateActions' :: Maybe Text
nextToken = Maybe Text
a} :: ListTemplateActions)

-- | Launch configuration template ID.
listTemplateActions_launchConfigurationTemplateID :: Lens.Lens' ListTemplateActions Prelude.Text
listTemplateActions_launchConfigurationTemplateID :: Lens' ListTemplateActions Text
listTemplateActions_launchConfigurationTemplateID = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateActions' {Text
launchConfigurationTemplateID :: Text
$sel:launchConfigurationTemplateID:ListTemplateActions' :: ListTemplateActions -> Text
launchConfigurationTemplateID} -> Text
launchConfigurationTemplateID) (\s :: ListTemplateActions
s@ListTemplateActions' {} Text
a -> ListTemplateActions
s {$sel:launchConfigurationTemplateID:ListTemplateActions' :: Text
launchConfigurationTemplateID = Text
a} :: ListTemplateActions)

instance Core.AWSPager ListTemplateActions where
  page :: ListTemplateActions
-> AWSResponse ListTemplateActions -> Maybe ListTemplateActions
page ListTemplateActions
rq AWSResponse ListTemplateActions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTemplateActions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTemplateActionsResponse (Maybe Text)
listTemplateActionsResponse_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 ListTemplateActions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTemplateActionsResponse (Maybe [TemplateActionDocument])
listTemplateActionsResponse_items
            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.$ ListTemplateActions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListTemplateActions (Maybe Text)
listTemplateActions_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListTemplateActions
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTemplateActionsResponse (Maybe Text)
listTemplateActionsResponse_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 ListTemplateActions where
  type
    AWSResponse ListTemplateActions =
      ListTemplateActionsResponse
  request :: (Service -> Service)
-> ListTemplateActions -> Request ListTemplateActions
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 ListTemplateActions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListTemplateActions)))
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 [TemplateActionDocument]
-> Maybe Text -> Int -> ListTemplateActionsResponse
ListTemplateActionsResponse'
            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
"items" 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 ListTemplateActions where
  hashWithSalt :: Int -> ListTemplateActions -> Int
hashWithSalt Int
_salt ListTemplateActions' {Maybe Natural
Maybe Text
Maybe TemplateActionsRequestFilters
Text
launchConfigurationTemplateID :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe TemplateActionsRequestFilters
$sel:launchConfigurationTemplateID:ListTemplateActions' :: ListTemplateActions -> Text
$sel:nextToken:ListTemplateActions' :: ListTemplateActions -> Maybe Text
$sel:maxResults:ListTemplateActions' :: ListTemplateActions -> Maybe Natural
$sel:filters:ListTemplateActions' :: ListTemplateActions -> Maybe TemplateActionsRequestFilters
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TemplateActionsRequestFilters
filters
      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
launchConfigurationTemplateID

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

instance Data.ToHeaders ListTemplateActions where
  toHeaders :: ListTemplateActions -> 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 ListTemplateActions where
  toJSON :: ListTemplateActions -> Value
toJSON ListTemplateActions' {Maybe Natural
Maybe Text
Maybe TemplateActionsRequestFilters
Text
launchConfigurationTemplateID :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe TemplateActionsRequestFilters
$sel:launchConfigurationTemplateID:ListTemplateActions' :: ListTemplateActions -> Text
$sel:nextToken:ListTemplateActions' :: ListTemplateActions -> Maybe Text
$sel:maxResults:ListTemplateActions' :: ListTemplateActions -> Maybe Natural
$sel:filters:ListTemplateActions' :: ListTemplateActions -> Maybe TemplateActionsRequestFilters
..} =
    [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 TemplateActionsRequestFilters
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 Natural
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
"launchConfigurationTemplateID"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
launchConfigurationTemplateID
              )
          ]
      )

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

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

-- | /See:/ 'newListTemplateActionsResponse' smart constructor.
data ListTemplateActionsResponse = ListTemplateActionsResponse'
  { -- | List of template post migration custom actions.
    ListTemplateActionsResponse -> Maybe [TemplateActionDocument]
items :: Prelude.Maybe [TemplateActionDocument],
    -- | Next token returned when listing template post migration custom actions.
    ListTemplateActionsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListTemplateActionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListTemplateActionsResponse -> ListTemplateActionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTemplateActionsResponse -> ListTemplateActionsResponse -> Bool
$c/= :: ListTemplateActionsResponse -> ListTemplateActionsResponse -> Bool
== :: ListTemplateActionsResponse -> ListTemplateActionsResponse -> Bool
$c== :: ListTemplateActionsResponse -> ListTemplateActionsResponse -> Bool
Prelude.Eq, ReadPrec [ListTemplateActionsResponse]
ReadPrec ListTemplateActionsResponse
Int -> ReadS ListTemplateActionsResponse
ReadS [ListTemplateActionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTemplateActionsResponse]
$creadListPrec :: ReadPrec [ListTemplateActionsResponse]
readPrec :: ReadPrec ListTemplateActionsResponse
$creadPrec :: ReadPrec ListTemplateActionsResponse
readList :: ReadS [ListTemplateActionsResponse]
$creadList :: ReadS [ListTemplateActionsResponse]
readsPrec :: Int -> ReadS ListTemplateActionsResponse
$creadsPrec :: Int -> ReadS ListTemplateActionsResponse
Prelude.Read, Int -> ListTemplateActionsResponse -> ShowS
[ListTemplateActionsResponse] -> ShowS
ListTemplateActionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTemplateActionsResponse] -> ShowS
$cshowList :: [ListTemplateActionsResponse] -> ShowS
show :: ListTemplateActionsResponse -> String
$cshow :: ListTemplateActionsResponse -> String
showsPrec :: Int -> ListTemplateActionsResponse -> ShowS
$cshowsPrec :: Int -> ListTemplateActionsResponse -> ShowS
Prelude.Show, forall x.
Rep ListTemplateActionsResponse x -> ListTemplateActionsResponse
forall x.
ListTemplateActionsResponse -> Rep ListTemplateActionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListTemplateActionsResponse x -> ListTemplateActionsResponse
$cfrom :: forall x.
ListTemplateActionsResponse -> Rep ListTemplateActionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListTemplateActionsResponse' 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:
--
-- 'items', 'listTemplateActionsResponse_items' - List of template post migration custom actions.
--
-- 'nextToken', 'listTemplateActionsResponse_nextToken' - Next token returned when listing template post migration custom actions.
--
-- 'httpStatus', 'listTemplateActionsResponse_httpStatus' - The response's http status code.
newListTemplateActionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListTemplateActionsResponse
newListTemplateActionsResponse :: Int -> ListTemplateActionsResponse
newListTemplateActionsResponse Int
pHttpStatus_ =
  ListTemplateActionsResponse'
    { $sel:items:ListTemplateActionsResponse' :: Maybe [TemplateActionDocument]
items =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListTemplateActionsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListTemplateActionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | List of template post migration custom actions.
listTemplateActionsResponse_items :: Lens.Lens' ListTemplateActionsResponse (Prelude.Maybe [TemplateActionDocument])
listTemplateActionsResponse_items :: Lens' ListTemplateActionsResponse (Maybe [TemplateActionDocument])
listTemplateActionsResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateActionsResponse' {Maybe [TemplateActionDocument]
items :: Maybe [TemplateActionDocument]
$sel:items:ListTemplateActionsResponse' :: ListTemplateActionsResponse -> Maybe [TemplateActionDocument]
items} -> Maybe [TemplateActionDocument]
items) (\s :: ListTemplateActionsResponse
s@ListTemplateActionsResponse' {} Maybe [TemplateActionDocument]
a -> ListTemplateActionsResponse
s {$sel:items:ListTemplateActionsResponse' :: Maybe [TemplateActionDocument]
items = Maybe [TemplateActionDocument]
a} :: ListTemplateActionsResponse) 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

-- | Next token returned when listing template post migration custom actions.
listTemplateActionsResponse_nextToken :: Lens.Lens' ListTemplateActionsResponse (Prelude.Maybe Prelude.Text)
listTemplateActionsResponse_nextToken :: Lens' ListTemplateActionsResponse (Maybe Text)
listTemplateActionsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTemplateActionsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTemplateActionsResponse' :: ListTemplateActionsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTemplateActionsResponse
s@ListTemplateActionsResponse' {} Maybe Text
a -> ListTemplateActionsResponse
s {$sel:nextToken:ListTemplateActionsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListTemplateActionsResponse)

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

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