{-# 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.PutImage
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates or updates the image manifest and tags associated with an image.
--
-- When an image is pushed and all new image layers have been uploaded, the
-- PutImage API is called once to create or update the image manifest and
-- the tags associated with the image.
--
-- This operation is used by the Amazon ECR proxy and is not generally used
-- by customers for pulling and pushing images. In most cases, you should
-- use the @docker@ CLI to pull, tag, and push images.
module Amazonka.ECR.PutImage
  ( -- * Creating a Request
    PutImage (..),
    newPutImage,

    -- * Request Lenses
    putImage_imageDigest,
    putImage_imageManifestMediaType,
    putImage_imageTag,
    putImage_registryId,
    putImage_repositoryName,
    putImage_imageManifest,

    -- * Destructuring the Response
    PutImageResponse (..),
    newPutImageResponse,

    -- * Response Lenses
    putImageResponse_image,
    putImageResponse_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:/ 'newPutImage' smart constructor.
data PutImage = PutImage'
  { -- | The image digest of the image manifest corresponding to the image.
    PutImage -> Maybe Text
imageDigest :: Prelude.Maybe Prelude.Text,
    -- | The media type of the image manifest. If you push an image manifest that
    -- does not contain the @mediaType@ field, you must specify the
    -- @imageManifestMediaType@ in the request.
    PutImage -> Maybe Text
imageManifestMediaType :: Prelude.Maybe Prelude.Text,
    -- | The tag to associate with the image. This parameter is required for
    -- images that use the Docker Image Manifest V2 Schema 2 or Open Container
    -- Initiative (OCI) formats.
    PutImage -> Maybe Text
imageTag :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services account ID associated with the registry that
    -- contains the repository in which to put the image. If you do not specify
    -- a registry, the default registry is assumed.
    PutImage -> Maybe Text
registryId :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository in which to put the image.
    PutImage -> Text
repositoryName :: Prelude.Text,
    -- | The image manifest corresponding to the image to be uploaded.
    PutImage -> Text
imageManifest :: Prelude.Text
  }
  deriving (PutImage -> PutImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutImage -> PutImage -> Bool
$c/= :: PutImage -> PutImage -> Bool
== :: PutImage -> PutImage -> Bool
$c== :: PutImage -> PutImage -> Bool
Prelude.Eq, ReadPrec [PutImage]
ReadPrec PutImage
Int -> ReadS PutImage
ReadS [PutImage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutImage]
$creadListPrec :: ReadPrec [PutImage]
readPrec :: ReadPrec PutImage
$creadPrec :: ReadPrec PutImage
readList :: ReadS [PutImage]
$creadList :: ReadS [PutImage]
readsPrec :: Int -> ReadS PutImage
$creadsPrec :: Int -> ReadS PutImage
Prelude.Read, Int -> PutImage -> ShowS
[PutImage] -> ShowS
PutImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutImage] -> ShowS
$cshowList :: [PutImage] -> ShowS
show :: PutImage -> String
$cshow :: PutImage -> String
showsPrec :: Int -> PutImage -> ShowS
$cshowsPrec :: Int -> PutImage -> ShowS
Prelude.Show, forall x. Rep PutImage x -> PutImage
forall x. PutImage -> Rep PutImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutImage x -> PutImage
$cfrom :: forall x. PutImage -> Rep PutImage x
Prelude.Generic)

-- |
-- Create a value of 'PutImage' 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:
--
-- 'imageDigest', 'putImage_imageDigest' - The image digest of the image manifest corresponding to the image.
--
-- 'imageManifestMediaType', 'putImage_imageManifestMediaType' - The media type of the image manifest. If you push an image manifest that
-- does not contain the @mediaType@ field, you must specify the
-- @imageManifestMediaType@ in the request.
--
-- 'imageTag', 'putImage_imageTag' - The tag to associate with the image. This parameter is required for
-- images that use the Docker Image Manifest V2 Schema 2 or Open Container
-- Initiative (OCI) formats.
--
-- 'registryId', 'putImage_registryId' - The Amazon Web Services account ID associated with the registry that
-- contains the repository in which to put the image. If you do not specify
-- a registry, the default registry is assumed.
--
-- 'repositoryName', 'putImage_repositoryName' - The name of the repository in which to put the image.
--
-- 'imageManifest', 'putImage_imageManifest' - The image manifest corresponding to the image to be uploaded.
newPutImage ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'imageManifest'
  Prelude.Text ->
  PutImage
newPutImage :: Text -> Text -> PutImage
newPutImage Text
pRepositoryName_ Text
pImageManifest_ =
  PutImage'
    { $sel:imageDigest:PutImage' :: Maybe Text
imageDigest = forall a. Maybe a
Prelude.Nothing,
      $sel:imageManifestMediaType:PutImage' :: Maybe Text
imageManifestMediaType = forall a. Maybe a
Prelude.Nothing,
      $sel:imageTag:PutImage' :: Maybe Text
imageTag = forall a. Maybe a
Prelude.Nothing,
      $sel:registryId:PutImage' :: Maybe Text
registryId = forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryName:PutImage' :: Text
repositoryName = Text
pRepositoryName_,
      $sel:imageManifest:PutImage' :: Text
imageManifest = Text
pImageManifest_
    }

-- | The image digest of the image manifest corresponding to the image.
putImage_imageDigest :: Lens.Lens' PutImage (Prelude.Maybe Prelude.Text)
putImage_imageDigest :: Lens' PutImage (Maybe Text)
putImage_imageDigest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutImage' {Maybe Text
imageDigest :: Maybe Text
$sel:imageDigest:PutImage' :: PutImage -> Maybe Text
imageDigest} -> Maybe Text
imageDigest) (\s :: PutImage
s@PutImage' {} Maybe Text
a -> PutImage
s {$sel:imageDigest:PutImage' :: Maybe Text
imageDigest = Maybe Text
a} :: PutImage)

-- | The media type of the image manifest. If you push an image manifest that
-- does not contain the @mediaType@ field, you must specify the
-- @imageManifestMediaType@ in the request.
putImage_imageManifestMediaType :: Lens.Lens' PutImage (Prelude.Maybe Prelude.Text)
putImage_imageManifestMediaType :: Lens' PutImage (Maybe Text)
putImage_imageManifestMediaType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutImage' {Maybe Text
imageManifestMediaType :: Maybe Text
$sel:imageManifestMediaType:PutImage' :: PutImage -> Maybe Text
imageManifestMediaType} -> Maybe Text
imageManifestMediaType) (\s :: PutImage
s@PutImage' {} Maybe Text
a -> PutImage
s {$sel:imageManifestMediaType:PutImage' :: Maybe Text
imageManifestMediaType = Maybe Text
a} :: PutImage)

-- | The tag to associate with the image. This parameter is required for
-- images that use the Docker Image Manifest V2 Schema 2 or Open Container
-- Initiative (OCI) formats.
putImage_imageTag :: Lens.Lens' PutImage (Prelude.Maybe Prelude.Text)
putImage_imageTag :: Lens' PutImage (Maybe Text)
putImage_imageTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutImage' {Maybe Text
imageTag :: Maybe Text
$sel:imageTag:PutImage' :: PutImage -> Maybe Text
imageTag} -> Maybe Text
imageTag) (\s :: PutImage
s@PutImage' {} Maybe Text
a -> PutImage
s {$sel:imageTag:PutImage' :: Maybe Text
imageTag = Maybe Text
a} :: PutImage)

-- | The Amazon Web Services account ID associated with the registry that
-- contains the repository in which to put the image. If you do not specify
-- a registry, the default registry is assumed.
putImage_registryId :: Lens.Lens' PutImage (Prelude.Maybe Prelude.Text)
putImage_registryId :: Lens' PutImage (Maybe Text)
putImage_registryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutImage' {Maybe Text
registryId :: Maybe Text
$sel:registryId:PutImage' :: PutImage -> Maybe Text
registryId} -> Maybe Text
registryId) (\s :: PutImage
s@PutImage' {} Maybe Text
a -> PutImage
s {$sel:registryId:PutImage' :: Maybe Text
registryId = Maybe Text
a} :: PutImage)

-- | The name of the repository in which to put the image.
putImage_repositoryName :: Lens.Lens' PutImage Prelude.Text
putImage_repositoryName :: Lens' PutImage Text
putImage_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutImage' {Text
repositoryName :: Text
$sel:repositoryName:PutImage' :: PutImage -> Text
repositoryName} -> Text
repositoryName) (\s :: PutImage
s@PutImage' {} Text
a -> PutImage
s {$sel:repositoryName:PutImage' :: Text
repositoryName = Text
a} :: PutImage)

-- | The image manifest corresponding to the image to be uploaded.
putImage_imageManifest :: Lens.Lens' PutImage Prelude.Text
putImage_imageManifest :: Lens' PutImage Text
putImage_imageManifest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutImage' {Text
imageManifest :: Text
$sel:imageManifest:PutImage' :: PutImage -> Text
imageManifest} -> Text
imageManifest) (\s :: PutImage
s@PutImage' {} Text
a -> PutImage
s {$sel:imageManifest:PutImage' :: Text
imageManifest = Text
a} :: PutImage)

instance Core.AWSRequest PutImage where
  type AWSResponse PutImage = PutImageResponse
  request :: (Service -> Service) -> PutImage -> Request PutImage
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 PutImage
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutImage)))
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 Image -> Int -> PutImageResponse
PutImageResponse'
            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
"image")
            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 PutImage where
  hashWithSalt :: Int -> PutImage -> Int
hashWithSalt Int
_salt PutImage' {Maybe Text
Text
imageManifest :: Text
repositoryName :: Text
registryId :: Maybe Text
imageTag :: Maybe Text
imageManifestMediaType :: Maybe Text
imageDigest :: Maybe Text
$sel:imageManifest:PutImage' :: PutImage -> Text
$sel:repositoryName:PutImage' :: PutImage -> Text
$sel:registryId:PutImage' :: PutImage -> Maybe Text
$sel:imageTag:PutImage' :: PutImage -> Maybe Text
$sel:imageManifestMediaType:PutImage' :: PutImage -> Maybe Text
$sel:imageDigest:PutImage' :: PutImage -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
imageDigest
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
imageManifestMediaType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
imageTag
      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` Text
imageManifest

instance Prelude.NFData PutImage where
  rnf :: PutImage -> ()
rnf PutImage' {Maybe Text
Text
imageManifest :: Text
repositoryName :: Text
registryId :: Maybe Text
imageTag :: Maybe Text
imageManifestMediaType :: Maybe Text
imageDigest :: Maybe Text
$sel:imageManifest:PutImage' :: PutImage -> Text
$sel:repositoryName:PutImage' :: PutImage -> Text
$sel:registryId:PutImage' :: PutImage -> Maybe Text
$sel:imageTag:PutImage' :: PutImage -> Maybe Text
$sel:imageManifestMediaType:PutImage' :: PutImage -> Maybe Text
$sel:imageDigest:PutImage' :: PutImage -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageDigest
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageManifestMediaType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageTag
      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 Text
imageManifest

instance Data.ToHeaders PutImage where
  toHeaders :: PutImage -> 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.PutImage" ::
                          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 PutImage where
  toJSON :: PutImage -> Value
toJSON PutImage' {Maybe Text
Text
imageManifest :: Text
repositoryName :: Text
registryId :: Maybe Text
imageTag :: Maybe Text
imageManifestMediaType :: Maybe Text
imageDigest :: Maybe Text
$sel:imageManifest:PutImage' :: PutImage -> Text
$sel:repositoryName:PutImage' :: PutImage -> Text
$sel:registryId:PutImage' :: PutImage -> Maybe Text
$sel:imageTag:PutImage' :: PutImage -> Maybe Text
$sel:imageManifestMediaType:PutImage' :: PutImage -> Maybe Text
$sel:imageDigest:PutImage' :: PutImage -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"imageDigest" 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
imageDigest,
            (Key
"imageManifestMediaType" 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
imageManifestMediaType,
            (Key
"imageTag" 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
imageTag,
            (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
"imageManifest" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
imageManifest)
          ]
      )

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

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

-- | /See:/ 'newPutImageResponse' smart constructor.
data PutImageResponse = PutImageResponse'
  { -- | Details of the image uploaded.
    PutImageResponse -> Maybe Image
image :: Prelude.Maybe Image,
    -- | The response's http status code.
    PutImageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutImageResponse -> PutImageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutImageResponse -> PutImageResponse -> Bool
$c/= :: PutImageResponse -> PutImageResponse -> Bool
== :: PutImageResponse -> PutImageResponse -> Bool
$c== :: PutImageResponse -> PutImageResponse -> Bool
Prelude.Eq, ReadPrec [PutImageResponse]
ReadPrec PutImageResponse
Int -> ReadS PutImageResponse
ReadS [PutImageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutImageResponse]
$creadListPrec :: ReadPrec [PutImageResponse]
readPrec :: ReadPrec PutImageResponse
$creadPrec :: ReadPrec PutImageResponse
readList :: ReadS [PutImageResponse]
$creadList :: ReadS [PutImageResponse]
readsPrec :: Int -> ReadS PutImageResponse
$creadsPrec :: Int -> ReadS PutImageResponse
Prelude.Read, Int -> PutImageResponse -> ShowS
[PutImageResponse] -> ShowS
PutImageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutImageResponse] -> ShowS
$cshowList :: [PutImageResponse] -> ShowS
show :: PutImageResponse -> String
$cshow :: PutImageResponse -> String
showsPrec :: Int -> PutImageResponse -> ShowS
$cshowsPrec :: Int -> PutImageResponse -> ShowS
Prelude.Show, forall x. Rep PutImageResponse x -> PutImageResponse
forall x. PutImageResponse -> Rep PutImageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutImageResponse x -> PutImageResponse
$cfrom :: forall x. PutImageResponse -> Rep PutImageResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutImageResponse' 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:
--
-- 'image', 'putImageResponse_image' - Details of the image uploaded.
--
-- 'httpStatus', 'putImageResponse_httpStatus' - The response's http status code.
newPutImageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutImageResponse
newPutImageResponse :: Int -> PutImageResponse
newPutImageResponse Int
pHttpStatus_ =
  PutImageResponse'
    { $sel:image:PutImageResponse' :: Maybe Image
image = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutImageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Details of the image uploaded.
putImageResponse_image :: Lens.Lens' PutImageResponse (Prelude.Maybe Image)
putImageResponse_image :: Lens' PutImageResponse (Maybe Image)
putImageResponse_image = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutImageResponse' {Maybe Image
image :: Maybe Image
$sel:image:PutImageResponse' :: PutImageResponse -> Maybe Image
image} -> Maybe Image
image) (\s :: PutImageResponse
s@PutImageResponse' {} Maybe Image
a -> PutImageResponse
s {$sel:image:PutImageResponse' :: Maybe Image
image = Maybe Image
a} :: PutImageResponse)

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

instance Prelude.NFData PutImageResponse where
  rnf :: PutImageResponse -> ()
rnf PutImageResponse' {Int
Maybe Image
httpStatus :: Int
image :: Maybe Image
$sel:httpStatus:PutImageResponse' :: PutImageResponse -> Int
$sel:image:PutImageResponse' :: PutImageResponse -> Maybe Image
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Image
image
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus