{-# 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.ImageBuilder.ListContainerRecipes
-- 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 container recipes.
module Amazonka.ImageBuilder.ListContainerRecipes
  ( -- * Creating a Request
    ListContainerRecipes (..),
    newListContainerRecipes,

    -- * Request Lenses
    listContainerRecipes_filters,
    listContainerRecipes_maxResults,
    listContainerRecipes_nextToken,
    listContainerRecipes_owner,

    -- * Destructuring the Response
    ListContainerRecipesResponse (..),
    newListContainerRecipesResponse,

    -- * Response Lenses
    listContainerRecipesResponse_containerRecipeSummaryList,
    listContainerRecipesResponse_nextToken,
    listContainerRecipesResponse_requestId,
    listContainerRecipesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListContainerRecipes' smart constructor.
data ListContainerRecipes = ListContainerRecipes'
  { -- | Use the following filters to streamline results:
    --
    -- -   @containerType@
    --
    -- -   @name@
    --
    -- -   @parentImage@
    --
    -- -   @platform@
    ListContainerRecipes -> Maybe (NonEmpty Filter)
filters :: Prelude.Maybe (Prelude.NonEmpty Filter),
    -- | The maximum number of results to return in the list.
    ListContainerRecipes -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Provides a token for pagination, which determines where to begin the
    -- next set of results when the current set reaches the maximum for one
    -- request.
    ListContainerRecipes -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Returns container recipes belonging to the specified owner, that have
    -- been shared with you. You can omit this field to return container
    -- recipes belonging to your account.
    ListContainerRecipes -> Maybe Ownership
owner :: Prelude.Maybe Ownership
  }
  deriving (ListContainerRecipes -> ListContainerRecipes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContainerRecipes -> ListContainerRecipes -> Bool
$c/= :: ListContainerRecipes -> ListContainerRecipes -> Bool
== :: ListContainerRecipes -> ListContainerRecipes -> Bool
$c== :: ListContainerRecipes -> ListContainerRecipes -> Bool
Prelude.Eq, ReadPrec [ListContainerRecipes]
ReadPrec ListContainerRecipes
Int -> ReadS ListContainerRecipes
ReadS [ListContainerRecipes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContainerRecipes]
$creadListPrec :: ReadPrec [ListContainerRecipes]
readPrec :: ReadPrec ListContainerRecipes
$creadPrec :: ReadPrec ListContainerRecipes
readList :: ReadS [ListContainerRecipes]
$creadList :: ReadS [ListContainerRecipes]
readsPrec :: Int -> ReadS ListContainerRecipes
$creadsPrec :: Int -> ReadS ListContainerRecipes
Prelude.Read, Int -> ListContainerRecipes -> ShowS
[ListContainerRecipes] -> ShowS
ListContainerRecipes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContainerRecipes] -> ShowS
$cshowList :: [ListContainerRecipes] -> ShowS
show :: ListContainerRecipes -> String
$cshow :: ListContainerRecipes -> String
showsPrec :: Int -> ListContainerRecipes -> ShowS
$cshowsPrec :: Int -> ListContainerRecipes -> ShowS
Prelude.Show, forall x. Rep ListContainerRecipes x -> ListContainerRecipes
forall x. ListContainerRecipes -> Rep ListContainerRecipes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListContainerRecipes x -> ListContainerRecipes
$cfrom :: forall x. ListContainerRecipes -> Rep ListContainerRecipes x
Prelude.Generic)

-- |
-- Create a value of 'ListContainerRecipes' 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', 'listContainerRecipes_filters' - Use the following filters to streamline results:
--
-- -   @containerType@
--
-- -   @name@
--
-- -   @parentImage@
--
-- -   @platform@
--
-- 'maxResults', 'listContainerRecipes_maxResults' - The maximum number of results to return in the list.
--
-- 'nextToken', 'listContainerRecipes_nextToken' - Provides a token for pagination, which determines where to begin the
-- next set of results when the current set reaches the maximum for one
-- request.
--
-- 'owner', 'listContainerRecipes_owner' - Returns container recipes belonging to the specified owner, that have
-- been shared with you. You can omit this field to return container
-- recipes belonging to your account.
newListContainerRecipes ::
  ListContainerRecipes
newListContainerRecipes :: ListContainerRecipes
newListContainerRecipes =
  ListContainerRecipes'
    { $sel:filters:ListContainerRecipes' :: Maybe (NonEmpty Filter)
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListContainerRecipes' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListContainerRecipes' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:owner:ListContainerRecipes' :: Maybe Ownership
owner = forall a. Maybe a
Prelude.Nothing
    }

-- | Use the following filters to streamline results:
--
-- -   @containerType@
--
-- -   @name@
--
-- -   @parentImage@
--
-- -   @platform@
listContainerRecipes_filters :: Lens.Lens' ListContainerRecipes (Prelude.Maybe (Prelude.NonEmpty Filter))
listContainerRecipes_filters :: Lens' ListContainerRecipes (Maybe (NonEmpty Filter))
listContainerRecipes_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerRecipes' {Maybe (NonEmpty Filter)
filters :: Maybe (NonEmpty Filter)
$sel:filters:ListContainerRecipes' :: ListContainerRecipes -> Maybe (NonEmpty Filter)
filters} -> Maybe (NonEmpty Filter)
filters) (\s :: ListContainerRecipes
s@ListContainerRecipes' {} Maybe (NonEmpty Filter)
a -> ListContainerRecipes
s {$sel:filters:ListContainerRecipes' :: Maybe (NonEmpty Filter)
filters = Maybe (NonEmpty Filter)
a} :: ListContainerRecipes) 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 maximum number of results to return in the list.
listContainerRecipes_maxResults :: Lens.Lens' ListContainerRecipes (Prelude.Maybe Prelude.Natural)
listContainerRecipes_maxResults :: Lens' ListContainerRecipes (Maybe Natural)
listContainerRecipes_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerRecipes' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListContainerRecipes' :: ListContainerRecipes -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListContainerRecipes
s@ListContainerRecipes' {} Maybe Natural
a -> ListContainerRecipes
s {$sel:maxResults:ListContainerRecipes' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListContainerRecipes)

-- | Provides a token for pagination, which determines where to begin the
-- next set of results when the current set reaches the maximum for one
-- request.
listContainerRecipes_nextToken :: Lens.Lens' ListContainerRecipes (Prelude.Maybe Prelude.Text)
listContainerRecipes_nextToken :: Lens' ListContainerRecipes (Maybe Text)
listContainerRecipes_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerRecipes' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContainerRecipes' :: ListContainerRecipes -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContainerRecipes
s@ListContainerRecipes' {} Maybe Text
a -> ListContainerRecipes
s {$sel:nextToken:ListContainerRecipes' :: Maybe Text
nextToken = Maybe Text
a} :: ListContainerRecipes)

-- | Returns container recipes belonging to the specified owner, that have
-- been shared with you. You can omit this field to return container
-- recipes belonging to your account.
listContainerRecipes_owner :: Lens.Lens' ListContainerRecipes (Prelude.Maybe Ownership)
listContainerRecipes_owner :: Lens' ListContainerRecipes (Maybe Ownership)
listContainerRecipes_owner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerRecipes' {Maybe Ownership
owner :: Maybe Ownership
$sel:owner:ListContainerRecipes' :: ListContainerRecipes -> Maybe Ownership
owner} -> Maybe Ownership
owner) (\s :: ListContainerRecipes
s@ListContainerRecipes' {} Maybe Ownership
a -> ListContainerRecipes
s {$sel:owner:ListContainerRecipes' :: Maybe Ownership
owner = Maybe Ownership
a} :: ListContainerRecipes)

instance Core.AWSRequest ListContainerRecipes where
  type
    AWSResponse ListContainerRecipes =
      ListContainerRecipesResponse
  request :: (Service -> Service)
-> ListContainerRecipes -> Request ListContainerRecipes
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 ListContainerRecipes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListContainerRecipes)))
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 [ContainerRecipeSummary]
-> Maybe Text -> Maybe Text -> Int -> ListContainerRecipesResponse
ListContainerRecipesResponse'
            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
"containerRecipeSummaryList"
                            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"requestId")
            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 ListContainerRecipes where
  hashWithSalt :: Int -> ListContainerRecipes -> Int
hashWithSalt Int
_salt ListContainerRecipes' {Maybe Natural
Maybe (NonEmpty Filter)
Maybe Text
Maybe Ownership
owner :: Maybe Ownership
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (NonEmpty Filter)
$sel:owner:ListContainerRecipes' :: ListContainerRecipes -> Maybe Ownership
$sel:nextToken:ListContainerRecipes' :: ListContainerRecipes -> Maybe Text
$sel:maxResults:ListContainerRecipes' :: ListContainerRecipes -> Maybe Natural
$sel:filters:ListContainerRecipes' :: ListContainerRecipes -> 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 Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Ownership
owner

instance Prelude.NFData ListContainerRecipes where
  rnf :: ListContainerRecipes -> ()
rnf ListContainerRecipes' {Maybe Natural
Maybe (NonEmpty Filter)
Maybe Text
Maybe Ownership
owner :: Maybe Ownership
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (NonEmpty Filter)
$sel:owner:ListContainerRecipes' :: ListContainerRecipes -> Maybe Ownership
$sel:nextToken:ListContainerRecipes' :: ListContainerRecipes -> Maybe Text
$sel:maxResults:ListContainerRecipes' :: ListContainerRecipes -> Maybe Natural
$sel:filters:ListContainerRecipes' :: ListContainerRecipes -> 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 Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Ownership
owner

instance Data.ToHeaders ListContainerRecipes where
  toHeaders :: ListContainerRecipes -> 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 ListContainerRecipes where
  toJSON :: ListContainerRecipes -> Value
toJSON ListContainerRecipes' {Maybe Natural
Maybe (NonEmpty Filter)
Maybe Text
Maybe Ownership
owner :: Maybe Ownership
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (NonEmpty Filter)
$sel:owner:ListContainerRecipes' :: ListContainerRecipes -> Maybe Ownership
$sel:nextToken:ListContainerRecipes' :: ListContainerRecipes -> Maybe Text
$sel:maxResults:ListContainerRecipes' :: ListContainerRecipes -> Maybe Natural
$sel:filters:ListContainerRecipes' :: ListContainerRecipes -> 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 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,
            (Key
"owner" 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 Ownership
owner
          ]
      )

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

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

-- | /See:/ 'newListContainerRecipesResponse' smart constructor.
data ListContainerRecipesResponse = ListContainerRecipesResponse'
  { -- | The list of container recipes returned for the request.
    ListContainerRecipesResponse -> Maybe [ContainerRecipeSummary]
containerRecipeSummaryList :: Prelude.Maybe [ContainerRecipeSummary],
    -- | The next token field is used for paginated responses. When this is not
    -- empty, there are additional container recipes that the service has not
    -- included in this response. Use this token with the next request to
    -- retrieve additional list items.
    ListContainerRecipesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The request ID that uniquely identifies this request.
    ListContainerRecipesResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListContainerRecipesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListContainerRecipesResponse
-> ListContainerRecipesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListContainerRecipesResponse
-> ListContainerRecipesResponse -> Bool
$c/= :: ListContainerRecipesResponse
-> ListContainerRecipesResponse -> Bool
== :: ListContainerRecipesResponse
-> ListContainerRecipesResponse -> Bool
$c== :: ListContainerRecipesResponse
-> ListContainerRecipesResponse -> Bool
Prelude.Eq, ReadPrec [ListContainerRecipesResponse]
ReadPrec ListContainerRecipesResponse
Int -> ReadS ListContainerRecipesResponse
ReadS [ListContainerRecipesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListContainerRecipesResponse]
$creadListPrec :: ReadPrec [ListContainerRecipesResponse]
readPrec :: ReadPrec ListContainerRecipesResponse
$creadPrec :: ReadPrec ListContainerRecipesResponse
readList :: ReadS [ListContainerRecipesResponse]
$creadList :: ReadS [ListContainerRecipesResponse]
readsPrec :: Int -> ReadS ListContainerRecipesResponse
$creadsPrec :: Int -> ReadS ListContainerRecipesResponse
Prelude.Read, Int -> ListContainerRecipesResponse -> ShowS
[ListContainerRecipesResponse] -> ShowS
ListContainerRecipesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListContainerRecipesResponse] -> ShowS
$cshowList :: [ListContainerRecipesResponse] -> ShowS
show :: ListContainerRecipesResponse -> String
$cshow :: ListContainerRecipesResponse -> String
showsPrec :: Int -> ListContainerRecipesResponse -> ShowS
$cshowsPrec :: Int -> ListContainerRecipesResponse -> ShowS
Prelude.Show, forall x.
Rep ListContainerRecipesResponse x -> ListContainerRecipesResponse
forall x.
ListContainerRecipesResponse -> Rep ListContainerRecipesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListContainerRecipesResponse x -> ListContainerRecipesResponse
$cfrom :: forall x.
ListContainerRecipesResponse -> Rep ListContainerRecipesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListContainerRecipesResponse' 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:
--
-- 'containerRecipeSummaryList', 'listContainerRecipesResponse_containerRecipeSummaryList' - The list of container recipes returned for the request.
--
-- 'nextToken', 'listContainerRecipesResponse_nextToken' - The next token field is used for paginated responses. When this is not
-- empty, there are additional container recipes that the service has not
-- included in this response. Use this token with the next request to
-- retrieve additional list items.
--
-- 'requestId', 'listContainerRecipesResponse_requestId' - The request ID that uniquely identifies this request.
--
-- 'httpStatus', 'listContainerRecipesResponse_httpStatus' - The response's http status code.
newListContainerRecipesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListContainerRecipesResponse
newListContainerRecipesResponse :: Int -> ListContainerRecipesResponse
newListContainerRecipesResponse Int
pHttpStatus_ =
  ListContainerRecipesResponse'
    { $sel:containerRecipeSummaryList:ListContainerRecipesResponse' :: Maybe [ContainerRecipeSummary]
containerRecipeSummaryList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListContainerRecipesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:ListContainerRecipesResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListContainerRecipesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of container recipes returned for the request.
listContainerRecipesResponse_containerRecipeSummaryList :: Lens.Lens' ListContainerRecipesResponse (Prelude.Maybe [ContainerRecipeSummary])
listContainerRecipesResponse_containerRecipeSummaryList :: Lens' ListContainerRecipesResponse (Maybe [ContainerRecipeSummary])
listContainerRecipesResponse_containerRecipeSummaryList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerRecipesResponse' {Maybe [ContainerRecipeSummary]
containerRecipeSummaryList :: Maybe [ContainerRecipeSummary]
$sel:containerRecipeSummaryList:ListContainerRecipesResponse' :: ListContainerRecipesResponse -> Maybe [ContainerRecipeSummary]
containerRecipeSummaryList} -> Maybe [ContainerRecipeSummary]
containerRecipeSummaryList) (\s :: ListContainerRecipesResponse
s@ListContainerRecipesResponse' {} Maybe [ContainerRecipeSummary]
a -> ListContainerRecipesResponse
s {$sel:containerRecipeSummaryList:ListContainerRecipesResponse' :: Maybe [ContainerRecipeSummary]
containerRecipeSummaryList = Maybe [ContainerRecipeSummary]
a} :: ListContainerRecipesResponse) 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 next token field is used for paginated responses. When this is not
-- empty, there are additional container recipes that the service has not
-- included in this response. Use this token with the next request to
-- retrieve additional list items.
listContainerRecipesResponse_nextToken :: Lens.Lens' ListContainerRecipesResponse (Prelude.Maybe Prelude.Text)
listContainerRecipesResponse_nextToken :: Lens' ListContainerRecipesResponse (Maybe Text)
listContainerRecipesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerRecipesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListContainerRecipesResponse' :: ListContainerRecipesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListContainerRecipesResponse
s@ListContainerRecipesResponse' {} Maybe Text
a -> ListContainerRecipesResponse
s {$sel:nextToken:ListContainerRecipesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListContainerRecipesResponse)

-- | The request ID that uniquely identifies this request.
listContainerRecipesResponse_requestId :: Lens.Lens' ListContainerRecipesResponse (Prelude.Maybe Prelude.Text)
listContainerRecipesResponse_requestId :: Lens' ListContainerRecipesResponse (Maybe Text)
listContainerRecipesResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListContainerRecipesResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:ListContainerRecipesResponse' :: ListContainerRecipesResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: ListContainerRecipesResponse
s@ListContainerRecipesResponse' {} Maybe Text
a -> ListContainerRecipesResponse
s {$sel:requestId:ListContainerRecipesResponse' :: Maybe Text
requestId = Maybe Text
a} :: ListContainerRecipesResponse)

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

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