{-# 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.ECR.BatchGetImage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets detailed information for an image. Images are specified with either
-- an @imageTag@ or @imageDigest@.
--
-- When an image is pulled, the BatchGetImage API is called once to
-- retrieve the image manifest.
module Amazonka.ECR.BatchGetImage
  ( -- * Creating a Request
    BatchGetImage (..),
    newBatchGetImage,

    -- * Request Lenses
    batchGetImage_acceptedMediaTypes,
    batchGetImage_registryId,
    batchGetImage_repositoryName,
    batchGetImage_imageIds,

    -- * Destructuring the Response
    BatchGetImageResponse (..),
    newBatchGetImageResponse,

    -- * Response Lenses
    batchGetImageResponse_failures,
    batchGetImageResponse_images,
    batchGetImageResponse_httpStatus,
  )
where

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

-- | /See:/ 'newBatchGetImage' smart constructor.
data BatchGetImage = BatchGetImage'
  { -- | The accepted media types for the request.
    --
    -- Valid values: @application\/vnd.docker.distribution.manifest.v1+json@ |
    -- @application\/vnd.docker.distribution.manifest.v2+json@ |
    -- @application\/vnd.oci.image.manifest.v1+json@
    BatchGetImage -> Maybe (NonEmpty Text)
acceptedMediaTypes :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The Amazon Web Services account ID associated with the registry that
    -- contains the images to describe. If you do not specify a registry, the
    -- default registry is assumed.
    BatchGetImage -> Maybe Text
registryId :: Prelude.Maybe Prelude.Text,
    -- | The repository that contains the images to describe.
    BatchGetImage -> Text
repositoryName :: Prelude.Text,
    -- | A list of image ID references that correspond to images to describe. The
    -- format of the @imageIds@ reference is @imageTag=tag@ or
    -- @imageDigest=digest@.
    BatchGetImage -> [ImageIdentifier]
imageIds :: [ImageIdentifier]
  }
  deriving (BatchGetImage -> BatchGetImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetImage -> BatchGetImage -> Bool
$c/= :: BatchGetImage -> BatchGetImage -> Bool
== :: BatchGetImage -> BatchGetImage -> Bool
$c== :: BatchGetImage -> BatchGetImage -> Bool
Prelude.Eq, ReadPrec [BatchGetImage]
ReadPrec BatchGetImage
Int -> ReadS BatchGetImage
ReadS [BatchGetImage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetImage]
$creadListPrec :: ReadPrec [BatchGetImage]
readPrec :: ReadPrec BatchGetImage
$creadPrec :: ReadPrec BatchGetImage
readList :: ReadS [BatchGetImage]
$creadList :: ReadS [BatchGetImage]
readsPrec :: Int -> ReadS BatchGetImage
$creadsPrec :: Int -> ReadS BatchGetImage
Prelude.Read, Int -> BatchGetImage -> ShowS
[BatchGetImage] -> ShowS
BatchGetImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetImage] -> ShowS
$cshowList :: [BatchGetImage] -> ShowS
show :: BatchGetImage -> String
$cshow :: BatchGetImage -> String
showsPrec :: Int -> BatchGetImage -> ShowS
$cshowsPrec :: Int -> BatchGetImage -> ShowS
Prelude.Show, forall x. Rep BatchGetImage x -> BatchGetImage
forall x. BatchGetImage -> Rep BatchGetImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetImage x -> BatchGetImage
$cfrom :: forall x. BatchGetImage -> Rep BatchGetImage x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetImage' 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:
--
-- 'acceptedMediaTypes', 'batchGetImage_acceptedMediaTypes' - The accepted media types for the request.
--
-- Valid values: @application\/vnd.docker.distribution.manifest.v1+json@ |
-- @application\/vnd.docker.distribution.manifest.v2+json@ |
-- @application\/vnd.oci.image.manifest.v1+json@
--
-- 'registryId', 'batchGetImage_registryId' - The Amazon Web Services account ID associated with the registry that
-- contains the images to describe. If you do not specify a registry, the
-- default registry is assumed.
--
-- 'repositoryName', 'batchGetImage_repositoryName' - The repository that contains the images to describe.
--
-- 'imageIds', 'batchGetImage_imageIds' - A list of image ID references that correspond to images to describe. The
-- format of the @imageIds@ reference is @imageTag=tag@ or
-- @imageDigest=digest@.
newBatchGetImage ::
  -- | 'repositoryName'
  Prelude.Text ->
  BatchGetImage
newBatchGetImage :: Text -> BatchGetImage
newBatchGetImage Text
pRepositoryName_ =
  BatchGetImage'
    { $sel:acceptedMediaTypes:BatchGetImage' :: Maybe (NonEmpty Text)
acceptedMediaTypes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:registryId:BatchGetImage' :: Maybe Text
registryId = forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryName:BatchGetImage' :: Text
repositoryName = Text
pRepositoryName_,
      $sel:imageIds:BatchGetImage' :: [ImageIdentifier]
imageIds = forall a. Monoid a => a
Prelude.mempty
    }

-- | The accepted media types for the request.
--
-- Valid values: @application\/vnd.docker.distribution.manifest.v1+json@ |
-- @application\/vnd.docker.distribution.manifest.v2+json@ |
-- @application\/vnd.oci.image.manifest.v1+json@
batchGetImage_acceptedMediaTypes :: Lens.Lens' BatchGetImage (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
batchGetImage_acceptedMediaTypes :: Lens' BatchGetImage (Maybe (NonEmpty Text))
batchGetImage_acceptedMediaTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetImage' {Maybe (NonEmpty Text)
acceptedMediaTypes :: Maybe (NonEmpty Text)
$sel:acceptedMediaTypes:BatchGetImage' :: BatchGetImage -> Maybe (NonEmpty Text)
acceptedMediaTypes} -> Maybe (NonEmpty Text)
acceptedMediaTypes) (\s :: BatchGetImage
s@BatchGetImage' {} Maybe (NonEmpty Text)
a -> BatchGetImage
s {$sel:acceptedMediaTypes:BatchGetImage' :: Maybe (NonEmpty Text)
acceptedMediaTypes = Maybe (NonEmpty Text)
a} :: BatchGetImage) 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 Amazon Web Services account ID associated with the registry that
-- contains the images to describe. If you do not specify a registry, the
-- default registry is assumed.
batchGetImage_registryId :: Lens.Lens' BatchGetImage (Prelude.Maybe Prelude.Text)
batchGetImage_registryId :: Lens' BatchGetImage (Maybe Text)
batchGetImage_registryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetImage' {Maybe Text
registryId :: Maybe Text
$sel:registryId:BatchGetImage' :: BatchGetImage -> Maybe Text
registryId} -> Maybe Text
registryId) (\s :: BatchGetImage
s@BatchGetImage' {} Maybe Text
a -> BatchGetImage
s {$sel:registryId:BatchGetImage' :: Maybe Text
registryId = Maybe Text
a} :: BatchGetImage)

-- | The repository that contains the images to describe.
batchGetImage_repositoryName :: Lens.Lens' BatchGetImage Prelude.Text
batchGetImage_repositoryName :: Lens' BatchGetImage Text
batchGetImage_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetImage' {Text
repositoryName :: Text
$sel:repositoryName:BatchGetImage' :: BatchGetImage -> Text
repositoryName} -> Text
repositoryName) (\s :: BatchGetImage
s@BatchGetImage' {} Text
a -> BatchGetImage
s {$sel:repositoryName:BatchGetImage' :: Text
repositoryName = Text
a} :: BatchGetImage)

-- | A list of image ID references that correspond to images to describe. The
-- format of the @imageIds@ reference is @imageTag=tag@ or
-- @imageDigest=digest@.
batchGetImage_imageIds :: Lens.Lens' BatchGetImage [ImageIdentifier]
batchGetImage_imageIds :: Lens' BatchGetImage [ImageIdentifier]
batchGetImage_imageIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetImage' {[ImageIdentifier]
imageIds :: [ImageIdentifier]
$sel:imageIds:BatchGetImage' :: BatchGetImage -> [ImageIdentifier]
imageIds} -> [ImageIdentifier]
imageIds) (\s :: BatchGetImage
s@BatchGetImage' {} [ImageIdentifier]
a -> BatchGetImage
s {$sel:imageIds:BatchGetImage' :: [ImageIdentifier]
imageIds = [ImageIdentifier]
a} :: BatchGetImage) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest BatchGetImage where
  type
    AWSResponse BatchGetImage =
      BatchGetImageResponse
  request :: (Service -> Service) -> BatchGetImage -> Request BatchGetImage
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 BatchGetImage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse BatchGetImage)))
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 [ImageFailure]
-> Maybe [Image] -> Int -> BatchGetImageResponse
BatchGetImageResponse'
            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
"failures" 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
"images" 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 BatchGetImage where
  hashWithSalt :: Int -> BatchGetImage -> Int
hashWithSalt Int
_salt BatchGetImage' {[ImageIdentifier]
Maybe (NonEmpty Text)
Maybe Text
Text
imageIds :: [ImageIdentifier]
repositoryName :: Text
registryId :: Maybe Text
acceptedMediaTypes :: Maybe (NonEmpty Text)
$sel:imageIds:BatchGetImage' :: BatchGetImage -> [ImageIdentifier]
$sel:repositoryName:BatchGetImage' :: BatchGetImage -> Text
$sel:registryId:BatchGetImage' :: BatchGetImage -> Maybe Text
$sel:acceptedMediaTypes:BatchGetImage' :: BatchGetImage -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
acceptedMediaTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
registryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [ImageIdentifier]
imageIds

instance Prelude.NFData BatchGetImage where
  rnf :: BatchGetImage -> ()
rnf BatchGetImage' {[ImageIdentifier]
Maybe (NonEmpty Text)
Maybe Text
Text
imageIds :: [ImageIdentifier]
repositoryName :: Text
registryId :: Maybe Text
acceptedMediaTypes :: Maybe (NonEmpty Text)
$sel:imageIds:BatchGetImage' :: BatchGetImage -> [ImageIdentifier]
$sel:repositoryName:BatchGetImage' :: BatchGetImage -> Text
$sel:registryId:BatchGetImage' :: BatchGetImage -> Maybe Text
$sel:acceptedMediaTypes:BatchGetImage' :: BatchGetImage -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
acceptedMediaTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
registryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
repositoryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ImageIdentifier]
imageIds

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

instance Data.ToJSON BatchGetImage where
  toJSON :: BatchGetImage -> Value
toJSON BatchGetImage' {[ImageIdentifier]
Maybe (NonEmpty Text)
Maybe Text
Text
imageIds :: [ImageIdentifier]
repositoryName :: Text
registryId :: Maybe Text
acceptedMediaTypes :: Maybe (NonEmpty Text)
$sel:imageIds:BatchGetImage' :: BatchGetImage -> [ImageIdentifier]
$sel:repositoryName:BatchGetImage' :: BatchGetImage -> Text
$sel:registryId:BatchGetImage' :: BatchGetImage -> Maybe Text
$sel:acceptedMediaTypes:BatchGetImage' :: BatchGetImage -> Maybe (NonEmpty Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"acceptedMediaTypes" 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 Text)
acceptedMediaTypes,
            (Key
"registryId" 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
registryId,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"repositoryName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
repositoryName),
            forall a. a -> Maybe a
Prelude.Just (Key
"imageIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [ImageIdentifier]
imageIds)
          ]
      )

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

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

-- | /See:/ 'newBatchGetImageResponse' smart constructor.
data BatchGetImageResponse = BatchGetImageResponse'
  { -- | Any failures associated with the call.
    BatchGetImageResponse -> Maybe [ImageFailure]
failures :: Prelude.Maybe [ImageFailure],
    -- | A list of image objects corresponding to the image references in the
    -- request.
    BatchGetImageResponse -> Maybe [Image]
images :: Prelude.Maybe [Image],
    -- | The response's http status code.
    BatchGetImageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetImageResponse -> BatchGetImageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetImageResponse -> BatchGetImageResponse -> Bool
$c/= :: BatchGetImageResponse -> BatchGetImageResponse -> Bool
== :: BatchGetImageResponse -> BatchGetImageResponse -> Bool
$c== :: BatchGetImageResponse -> BatchGetImageResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetImageResponse]
ReadPrec BatchGetImageResponse
Int -> ReadS BatchGetImageResponse
ReadS [BatchGetImageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetImageResponse]
$creadListPrec :: ReadPrec [BatchGetImageResponse]
readPrec :: ReadPrec BatchGetImageResponse
$creadPrec :: ReadPrec BatchGetImageResponse
readList :: ReadS [BatchGetImageResponse]
$creadList :: ReadS [BatchGetImageResponse]
readsPrec :: Int -> ReadS BatchGetImageResponse
$creadsPrec :: Int -> ReadS BatchGetImageResponse
Prelude.Read, Int -> BatchGetImageResponse -> ShowS
[BatchGetImageResponse] -> ShowS
BatchGetImageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetImageResponse] -> ShowS
$cshowList :: [BatchGetImageResponse] -> ShowS
show :: BatchGetImageResponse -> String
$cshow :: BatchGetImageResponse -> String
showsPrec :: Int -> BatchGetImageResponse -> ShowS
$cshowsPrec :: Int -> BatchGetImageResponse -> ShowS
Prelude.Show, forall x. Rep BatchGetImageResponse x -> BatchGetImageResponse
forall x. BatchGetImageResponse -> Rep BatchGetImageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetImageResponse x -> BatchGetImageResponse
$cfrom :: forall x. BatchGetImageResponse -> Rep BatchGetImageResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetImageResponse' 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:
--
-- 'failures', 'batchGetImageResponse_failures' - Any failures associated with the call.
--
-- 'images', 'batchGetImageResponse_images' - A list of image objects corresponding to the image references in the
-- request.
--
-- 'httpStatus', 'batchGetImageResponse_httpStatus' - The response's http status code.
newBatchGetImageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetImageResponse
newBatchGetImageResponse :: Int -> BatchGetImageResponse
newBatchGetImageResponse Int
pHttpStatus_ =
  BatchGetImageResponse'
    { $sel:failures:BatchGetImageResponse' :: Maybe [ImageFailure]
failures = forall a. Maybe a
Prelude.Nothing,
      $sel:images:BatchGetImageResponse' :: Maybe [Image]
images = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetImageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Any failures associated with the call.
batchGetImageResponse_failures :: Lens.Lens' BatchGetImageResponse (Prelude.Maybe [ImageFailure])
batchGetImageResponse_failures :: Lens' BatchGetImageResponse (Maybe [ImageFailure])
batchGetImageResponse_failures = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetImageResponse' {Maybe [ImageFailure]
failures :: Maybe [ImageFailure]
$sel:failures:BatchGetImageResponse' :: BatchGetImageResponse -> Maybe [ImageFailure]
failures} -> Maybe [ImageFailure]
failures) (\s :: BatchGetImageResponse
s@BatchGetImageResponse' {} Maybe [ImageFailure]
a -> BatchGetImageResponse
s {$sel:failures:BatchGetImageResponse' :: Maybe [ImageFailure]
failures = Maybe [ImageFailure]
a} :: BatchGetImageResponse) 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

-- | A list of image objects corresponding to the image references in the
-- request.
batchGetImageResponse_images :: Lens.Lens' BatchGetImageResponse (Prelude.Maybe [Image])
batchGetImageResponse_images :: Lens' BatchGetImageResponse (Maybe [Image])
batchGetImageResponse_images = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetImageResponse' {Maybe [Image]
images :: Maybe [Image]
$sel:images:BatchGetImageResponse' :: BatchGetImageResponse -> Maybe [Image]
images} -> Maybe [Image]
images) (\s :: BatchGetImageResponse
s@BatchGetImageResponse' {} Maybe [Image]
a -> BatchGetImageResponse
s {$sel:images:BatchGetImageResponse' :: Maybe [Image]
images = Maybe [Image]
a} :: BatchGetImageResponse) 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.
batchGetImageResponse_httpStatus :: Lens.Lens' BatchGetImageResponse Prelude.Int
batchGetImageResponse_httpStatus :: Lens' BatchGetImageResponse Int
batchGetImageResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetImageResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetImageResponse' :: BatchGetImageResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetImageResponse
s@BatchGetImageResponse' {} Int
a -> BatchGetImageResponse
s {$sel:httpStatus:BatchGetImageResponse' :: Int
httpStatus = Int
a} :: BatchGetImageResponse)

instance Prelude.NFData BatchGetImageResponse where
  rnf :: BatchGetImageResponse -> ()
rnf BatchGetImageResponse' {Int
Maybe [ImageFailure]
Maybe [Image]
httpStatus :: Int
images :: Maybe [Image]
failures :: Maybe [ImageFailure]
$sel:httpStatus:BatchGetImageResponse' :: BatchGetImageResponse -> Int
$sel:images:BatchGetImageResponse' :: BatchGetImageResponse -> Maybe [Image]
$sel:failures:BatchGetImageResponse' :: BatchGetImageResponse -> Maybe [ImageFailure]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ImageFailure]
failures
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Image]
images
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus