{-# 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.ListImages
-- 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 the list of images that you have access to.
module Amazonka.ImageBuilder.ListImages
  ( -- * Creating a Request
    ListImages (..),
    newListImages,

    -- * Request Lenses
    listImages_byName,
    listImages_filters,
    listImages_includeDeprecated,
    listImages_maxResults,
    listImages_nextToken,
    listImages_owner,

    -- * Destructuring the Response
    ListImagesResponse (..),
    newListImagesResponse,

    -- * Response Lenses
    listImagesResponse_imageVersionList,
    listImagesResponse_nextToken,
    listImagesResponse_requestId,
    listImagesResponse_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:/ 'newListImages' smart constructor.
data ListImages = ListImages'
  { -- | Requests a list of images with a specific recipe name.
    ListImages -> Maybe Bool
byName :: Prelude.Maybe Prelude.Bool,
    -- | Use the following filters to streamline results:
    --
    -- -   @name@
    --
    -- -   @osVersion@
    --
    -- -   @platform@
    --
    -- -   @type@
    --
    -- -   @version@
    ListImages -> Maybe (NonEmpty Filter)
filters :: Prelude.Maybe (Prelude.NonEmpty Filter),
    -- | Includes deprecated images in the response list.
    ListImages -> Maybe Bool
includeDeprecated :: Prelude.Maybe Prelude.Bool,
    -- | The maximum items to return in a request.
    ListImages -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A token to specify where to start paginating. This is the NextToken from
    -- a previously truncated response.
    ListImages -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The owner defines which images you want to list. By default, this
    -- request will only show images owned by your account. You can use this
    -- field to specify if you want to view images owned by yourself, by
    -- Amazon, or those images that have been shared with you by other
    -- customers.
    ListImages -> Maybe Ownership
owner :: Prelude.Maybe Ownership
  }
  deriving (ListImages -> ListImages -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListImages -> ListImages -> Bool
$c/= :: ListImages -> ListImages -> Bool
== :: ListImages -> ListImages -> Bool
$c== :: ListImages -> ListImages -> Bool
Prelude.Eq, ReadPrec [ListImages]
ReadPrec ListImages
Int -> ReadS ListImages
ReadS [ListImages]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListImages]
$creadListPrec :: ReadPrec [ListImages]
readPrec :: ReadPrec ListImages
$creadPrec :: ReadPrec ListImages
readList :: ReadS [ListImages]
$creadList :: ReadS [ListImages]
readsPrec :: Int -> ReadS ListImages
$creadsPrec :: Int -> ReadS ListImages
Prelude.Read, Int -> ListImages -> ShowS
[ListImages] -> ShowS
ListImages -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListImages] -> ShowS
$cshowList :: [ListImages] -> ShowS
show :: ListImages -> String
$cshow :: ListImages -> String
showsPrec :: Int -> ListImages -> ShowS
$cshowsPrec :: Int -> ListImages -> ShowS
Prelude.Show, forall x. Rep ListImages x -> ListImages
forall x. ListImages -> Rep ListImages x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListImages x -> ListImages
$cfrom :: forall x. ListImages -> Rep ListImages x
Prelude.Generic)

-- |
-- Create a value of 'ListImages' 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:
--
-- 'byName', 'listImages_byName' - Requests a list of images with a specific recipe name.
--
-- 'filters', 'listImages_filters' - Use the following filters to streamline results:
--
-- -   @name@
--
-- -   @osVersion@
--
-- -   @platform@
--
-- -   @type@
--
-- -   @version@
--
-- 'includeDeprecated', 'listImages_includeDeprecated' - Includes deprecated images in the response list.
--
-- 'maxResults', 'listImages_maxResults' - The maximum items to return in a request.
--
-- 'nextToken', 'listImages_nextToken' - A token to specify where to start paginating. This is the NextToken from
-- a previously truncated response.
--
-- 'owner', 'listImages_owner' - The owner defines which images you want to list. By default, this
-- request will only show images owned by your account. You can use this
-- field to specify if you want to view images owned by yourself, by
-- Amazon, or those images that have been shared with you by other
-- customers.
newListImages ::
  ListImages
newListImages :: ListImages
newListImages =
  ListImages'
    { $sel:byName:ListImages' :: Maybe Bool
byName = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:ListImages' :: Maybe (NonEmpty Filter)
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:includeDeprecated:ListImages' :: Maybe Bool
includeDeprecated = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListImages' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListImages' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:owner:ListImages' :: Maybe Ownership
owner = forall a. Maybe a
Prelude.Nothing
    }

-- | Requests a list of images with a specific recipe name.
listImages_byName :: Lens.Lens' ListImages (Prelude.Maybe Prelude.Bool)
listImages_byName :: Lens' ListImages (Maybe Bool)
listImages_byName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImages' {Maybe Bool
byName :: Maybe Bool
$sel:byName:ListImages' :: ListImages -> Maybe Bool
byName} -> Maybe Bool
byName) (\s :: ListImages
s@ListImages' {} Maybe Bool
a -> ListImages
s {$sel:byName:ListImages' :: Maybe Bool
byName = Maybe Bool
a} :: ListImages)

-- | Use the following filters to streamline results:
--
-- -   @name@
--
-- -   @osVersion@
--
-- -   @platform@
--
-- -   @type@
--
-- -   @version@
listImages_filters :: Lens.Lens' ListImages (Prelude.Maybe (Prelude.NonEmpty Filter))
listImages_filters :: Lens' ListImages (Maybe (NonEmpty Filter))
listImages_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImages' {Maybe (NonEmpty Filter)
filters :: Maybe (NonEmpty Filter)
$sel:filters:ListImages' :: ListImages -> Maybe (NonEmpty Filter)
filters} -> Maybe (NonEmpty Filter)
filters) (\s :: ListImages
s@ListImages' {} Maybe (NonEmpty Filter)
a -> ListImages
s {$sel:filters:ListImages' :: Maybe (NonEmpty Filter)
filters = Maybe (NonEmpty Filter)
a} :: ListImages) 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

-- | Includes deprecated images in the response list.
listImages_includeDeprecated :: Lens.Lens' ListImages (Prelude.Maybe Prelude.Bool)
listImages_includeDeprecated :: Lens' ListImages (Maybe Bool)
listImages_includeDeprecated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImages' {Maybe Bool
includeDeprecated :: Maybe Bool
$sel:includeDeprecated:ListImages' :: ListImages -> Maybe Bool
includeDeprecated} -> Maybe Bool
includeDeprecated) (\s :: ListImages
s@ListImages' {} Maybe Bool
a -> ListImages
s {$sel:includeDeprecated:ListImages' :: Maybe Bool
includeDeprecated = Maybe Bool
a} :: ListImages)

-- | The maximum items to return in a request.
listImages_maxResults :: Lens.Lens' ListImages (Prelude.Maybe Prelude.Natural)
listImages_maxResults :: Lens' ListImages (Maybe Natural)
listImages_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImages' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListImages' :: ListImages -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListImages
s@ListImages' {} Maybe Natural
a -> ListImages
s {$sel:maxResults:ListImages' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListImages)

-- | A token to specify where to start paginating. This is the NextToken from
-- a previously truncated response.
listImages_nextToken :: Lens.Lens' ListImages (Prelude.Maybe Prelude.Text)
listImages_nextToken :: Lens' ListImages (Maybe Text)
listImages_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImages' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListImages' :: ListImages -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListImages
s@ListImages' {} Maybe Text
a -> ListImages
s {$sel:nextToken:ListImages' :: Maybe Text
nextToken = Maybe Text
a} :: ListImages)

-- | The owner defines which images you want to list. By default, this
-- request will only show images owned by your account. You can use this
-- field to specify if you want to view images owned by yourself, by
-- Amazon, or those images that have been shared with you by other
-- customers.
listImages_owner :: Lens.Lens' ListImages (Prelude.Maybe Ownership)
listImages_owner :: Lens' ListImages (Maybe Ownership)
listImages_owner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImages' {Maybe Ownership
owner :: Maybe Ownership
$sel:owner:ListImages' :: ListImages -> Maybe Ownership
owner} -> Maybe Ownership
owner) (\s :: ListImages
s@ListImages' {} Maybe Ownership
a -> ListImages
s {$sel:owner:ListImages' :: Maybe Ownership
owner = Maybe Ownership
a} :: ListImages)

instance Core.AWSRequest ListImages where
  type AWSResponse ListImages = ListImagesResponse
  request :: (Service -> Service) -> ListImages -> Request ListImages
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 ListImages
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListImages)))
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 [ImageVersion]
-> Maybe Text -> Maybe Text -> Int -> ListImagesResponse
ListImagesResponse'
            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
"imageVersionList"
                            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 ListImages where
  hashWithSalt :: Int -> ListImages -> Int
hashWithSalt Int
_salt ListImages' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Filter)
Maybe Text
Maybe Ownership
owner :: Maybe Ownership
nextToken :: Maybe Text
maxResults :: Maybe Natural
includeDeprecated :: Maybe Bool
filters :: Maybe (NonEmpty Filter)
byName :: Maybe Bool
$sel:owner:ListImages' :: ListImages -> Maybe Ownership
$sel:nextToken:ListImages' :: ListImages -> Maybe Text
$sel:maxResults:ListImages' :: ListImages -> Maybe Natural
$sel:includeDeprecated:ListImages' :: ListImages -> Maybe Bool
$sel:filters:ListImages' :: ListImages -> Maybe (NonEmpty Filter)
$sel:byName:ListImages' :: ListImages -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
byName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Filter)
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeDeprecated
      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 ListImages where
  rnf :: ListImages -> ()
rnf ListImages' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Filter)
Maybe Text
Maybe Ownership
owner :: Maybe Ownership
nextToken :: Maybe Text
maxResults :: Maybe Natural
includeDeprecated :: Maybe Bool
filters :: Maybe (NonEmpty Filter)
byName :: Maybe Bool
$sel:owner:ListImages' :: ListImages -> Maybe Ownership
$sel:nextToken:ListImages' :: ListImages -> Maybe Text
$sel:maxResults:ListImages' :: ListImages -> Maybe Natural
$sel:includeDeprecated:ListImages' :: ListImages -> Maybe Bool
$sel:filters:ListImages' :: ListImages -> Maybe (NonEmpty Filter)
$sel:byName:ListImages' :: ListImages -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
byName
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Bool
includeDeprecated
      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 ListImages where
  toHeaders :: ListImages -> 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 ListImages where
  toJSON :: ListImages -> Value
toJSON ListImages' {Maybe Bool
Maybe Natural
Maybe (NonEmpty Filter)
Maybe Text
Maybe Ownership
owner :: Maybe Ownership
nextToken :: Maybe Text
maxResults :: Maybe Natural
includeDeprecated :: Maybe Bool
filters :: Maybe (NonEmpty Filter)
byName :: Maybe Bool
$sel:owner:ListImages' :: ListImages -> Maybe Ownership
$sel:nextToken:ListImages' :: ListImages -> Maybe Text
$sel:maxResults:ListImages' :: ListImages -> Maybe Natural
$sel:includeDeprecated:ListImages' :: ListImages -> Maybe Bool
$sel:filters:ListImages' :: ListImages -> Maybe (NonEmpty Filter)
$sel:byName:ListImages' :: ListImages -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"byName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
byName,
            (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
"includeDeprecated" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
includeDeprecated,
            (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 ListImages where
  toPath :: ListImages -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/ListImages"

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

-- | /See:/ 'newListImagesResponse' smart constructor.
data ListImagesResponse = ListImagesResponse'
  { -- | The list of image semantic versions.
    --
    -- The semantic version has four nodes:
    -- \<major>.\<minor>.\<patch>\/\<build>. You can assign values for the
    -- first three, and can filter on all of them.
    --
    -- __Filtering:__ With semantic versioning, you have the flexibility to use
    -- wildcards (x) to specify the most recent versions or nodes when
    -- selecting the base image or components for your recipe. When you use a
    -- wildcard in any node, all nodes to the right of the first wildcard must
    -- also be wildcards.
    ListImagesResponse -> Maybe [ImageVersion]
imageVersionList :: Prelude.Maybe [ImageVersion],
    -- | The next token used for paginated responses. When this is not empty,
    -- there are additional elements that the service has not included in this
    -- request. Use this token with the next request to retrieve additional
    -- objects.
    ListImagesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The request ID that uniquely identifies this request.
    ListImagesResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListImagesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListImagesResponse -> ListImagesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListImagesResponse -> ListImagesResponse -> Bool
$c/= :: ListImagesResponse -> ListImagesResponse -> Bool
== :: ListImagesResponse -> ListImagesResponse -> Bool
$c== :: ListImagesResponse -> ListImagesResponse -> Bool
Prelude.Eq, ReadPrec [ListImagesResponse]
ReadPrec ListImagesResponse
Int -> ReadS ListImagesResponse
ReadS [ListImagesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListImagesResponse]
$creadListPrec :: ReadPrec [ListImagesResponse]
readPrec :: ReadPrec ListImagesResponse
$creadPrec :: ReadPrec ListImagesResponse
readList :: ReadS [ListImagesResponse]
$creadList :: ReadS [ListImagesResponse]
readsPrec :: Int -> ReadS ListImagesResponse
$creadsPrec :: Int -> ReadS ListImagesResponse
Prelude.Read, Int -> ListImagesResponse -> ShowS
[ListImagesResponse] -> ShowS
ListImagesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListImagesResponse] -> ShowS
$cshowList :: [ListImagesResponse] -> ShowS
show :: ListImagesResponse -> String
$cshow :: ListImagesResponse -> String
showsPrec :: Int -> ListImagesResponse -> ShowS
$cshowsPrec :: Int -> ListImagesResponse -> ShowS
Prelude.Show, forall x. Rep ListImagesResponse x -> ListImagesResponse
forall x. ListImagesResponse -> Rep ListImagesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListImagesResponse x -> ListImagesResponse
$cfrom :: forall x. ListImagesResponse -> Rep ListImagesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListImagesResponse' 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:
--
-- 'imageVersionList', 'listImagesResponse_imageVersionList' - The list of image semantic versions.
--
-- The semantic version has four nodes:
-- \<major>.\<minor>.\<patch>\/\<build>. You can assign values for the
-- first three, and can filter on all of them.
--
-- __Filtering:__ With semantic versioning, you have the flexibility to use
-- wildcards (x) to specify the most recent versions or nodes when
-- selecting the base image or components for your recipe. When you use a
-- wildcard in any node, all nodes to the right of the first wildcard must
-- also be wildcards.
--
-- 'nextToken', 'listImagesResponse_nextToken' - The next token used for paginated responses. When this is not empty,
-- there are additional elements that the service has not included in this
-- request. Use this token with the next request to retrieve additional
-- objects.
--
-- 'requestId', 'listImagesResponse_requestId' - The request ID that uniquely identifies this request.
--
-- 'httpStatus', 'listImagesResponse_httpStatus' - The response's http status code.
newListImagesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListImagesResponse
newListImagesResponse :: Int -> ListImagesResponse
newListImagesResponse Int
pHttpStatus_ =
  ListImagesResponse'
    { $sel:imageVersionList:ListImagesResponse' :: Maybe [ImageVersion]
imageVersionList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListImagesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:ListImagesResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListImagesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of image semantic versions.
--
-- The semantic version has four nodes:
-- \<major>.\<minor>.\<patch>\/\<build>. You can assign values for the
-- first three, and can filter on all of them.
--
-- __Filtering:__ With semantic versioning, you have the flexibility to use
-- wildcards (x) to specify the most recent versions or nodes when
-- selecting the base image or components for your recipe. When you use a
-- wildcard in any node, all nodes to the right of the first wildcard must
-- also be wildcards.
listImagesResponse_imageVersionList :: Lens.Lens' ListImagesResponse (Prelude.Maybe [ImageVersion])
listImagesResponse_imageVersionList :: Lens' ListImagesResponse (Maybe [ImageVersion])
listImagesResponse_imageVersionList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImagesResponse' {Maybe [ImageVersion]
imageVersionList :: Maybe [ImageVersion]
$sel:imageVersionList:ListImagesResponse' :: ListImagesResponse -> Maybe [ImageVersion]
imageVersionList} -> Maybe [ImageVersion]
imageVersionList) (\s :: ListImagesResponse
s@ListImagesResponse' {} Maybe [ImageVersion]
a -> ListImagesResponse
s {$sel:imageVersionList:ListImagesResponse' :: Maybe [ImageVersion]
imageVersionList = Maybe [ImageVersion]
a} :: ListImagesResponse) 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 used for paginated responses. When this is not empty,
-- there are additional elements that the service has not included in this
-- request. Use this token with the next request to retrieve additional
-- objects.
listImagesResponse_nextToken :: Lens.Lens' ListImagesResponse (Prelude.Maybe Prelude.Text)
listImagesResponse_nextToken :: Lens' ListImagesResponse (Maybe Text)
listImagesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImagesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListImagesResponse' :: ListImagesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListImagesResponse
s@ListImagesResponse' {} Maybe Text
a -> ListImagesResponse
s {$sel:nextToken:ListImagesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListImagesResponse)

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

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

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