{-# 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.PutImageTagMutability
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the image tag mutability settings for the specified repository.
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonECR/latest/userguide/image-tag-mutability.html Image tag mutability>
-- in the /Amazon Elastic Container Registry User Guide/.
module Amazonka.ECR.PutImageTagMutability
  ( -- * Creating a Request
    PutImageTagMutability (..),
    newPutImageTagMutability,

    -- * Request Lenses
    putImageTagMutability_registryId,
    putImageTagMutability_repositoryName,
    putImageTagMutability_imageTagMutability,

    -- * Destructuring the Response
    PutImageTagMutabilityResponse (..),
    newPutImageTagMutabilityResponse,

    -- * Response Lenses
    putImageTagMutabilityResponse_imageTagMutability,
    putImageTagMutabilityResponse_registryId,
    putImageTagMutabilityResponse_repositoryName,
    putImageTagMutabilityResponse_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:/ 'newPutImageTagMutability' smart constructor.
data PutImageTagMutability = PutImageTagMutability'
  { -- | The Amazon Web Services account ID associated with the registry that
    -- contains the repository in which to update the image tag mutability
    -- settings. If you do not specify a registry, the default registry is
    -- assumed.
    PutImageTagMutability -> Maybe Text
registryId :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository in which to update the image tag mutability
    -- settings.
    PutImageTagMutability -> Text
repositoryName :: Prelude.Text,
    -- | The tag mutability setting for the repository. If @MUTABLE@ is
    -- specified, image tags can be overwritten. If @IMMUTABLE@ is specified,
    -- all image tags within the repository will be immutable which will
    -- prevent them from being overwritten.
    PutImageTagMutability -> ImageTagMutability
imageTagMutability :: ImageTagMutability
  }
  deriving (PutImageTagMutability -> PutImageTagMutability -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutImageTagMutability -> PutImageTagMutability -> Bool
$c/= :: PutImageTagMutability -> PutImageTagMutability -> Bool
== :: PutImageTagMutability -> PutImageTagMutability -> Bool
$c== :: PutImageTagMutability -> PutImageTagMutability -> Bool
Prelude.Eq, ReadPrec [PutImageTagMutability]
ReadPrec PutImageTagMutability
Int -> ReadS PutImageTagMutability
ReadS [PutImageTagMutability]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutImageTagMutability]
$creadListPrec :: ReadPrec [PutImageTagMutability]
readPrec :: ReadPrec PutImageTagMutability
$creadPrec :: ReadPrec PutImageTagMutability
readList :: ReadS [PutImageTagMutability]
$creadList :: ReadS [PutImageTagMutability]
readsPrec :: Int -> ReadS PutImageTagMutability
$creadsPrec :: Int -> ReadS PutImageTagMutability
Prelude.Read, Int -> PutImageTagMutability -> ShowS
[PutImageTagMutability] -> ShowS
PutImageTagMutability -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutImageTagMutability] -> ShowS
$cshowList :: [PutImageTagMutability] -> ShowS
show :: PutImageTagMutability -> String
$cshow :: PutImageTagMutability -> String
showsPrec :: Int -> PutImageTagMutability -> ShowS
$cshowsPrec :: Int -> PutImageTagMutability -> ShowS
Prelude.Show, forall x. Rep PutImageTagMutability x -> PutImageTagMutability
forall x. PutImageTagMutability -> Rep PutImageTagMutability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutImageTagMutability x -> PutImageTagMutability
$cfrom :: forall x. PutImageTagMutability -> Rep PutImageTagMutability x
Prelude.Generic)

-- |
-- Create a value of 'PutImageTagMutability' 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:
--
-- 'registryId', 'putImageTagMutability_registryId' - The Amazon Web Services account ID associated with the registry that
-- contains the repository in which to update the image tag mutability
-- settings. If you do not specify a registry, the default registry is
-- assumed.
--
-- 'repositoryName', 'putImageTagMutability_repositoryName' - The name of the repository in which to update the image tag mutability
-- settings.
--
-- 'imageTagMutability', 'putImageTagMutability_imageTagMutability' - The tag mutability setting for the repository. If @MUTABLE@ is
-- specified, image tags can be overwritten. If @IMMUTABLE@ is specified,
-- all image tags within the repository will be immutable which will
-- prevent them from being overwritten.
newPutImageTagMutability ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'imageTagMutability'
  ImageTagMutability ->
  PutImageTagMutability
newPutImageTagMutability :: Text -> ImageTagMutability -> PutImageTagMutability
newPutImageTagMutability
  Text
pRepositoryName_
  ImageTagMutability
pImageTagMutability_ =
    PutImageTagMutability'
      { $sel:registryId:PutImageTagMutability' :: Maybe Text
registryId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:repositoryName:PutImageTagMutability' :: Text
repositoryName = Text
pRepositoryName_,
        $sel:imageTagMutability:PutImageTagMutability' :: ImageTagMutability
imageTagMutability = ImageTagMutability
pImageTagMutability_
      }

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

-- | The name of the repository in which to update the image tag mutability
-- settings.
putImageTagMutability_repositoryName :: Lens.Lens' PutImageTagMutability Prelude.Text
putImageTagMutability_repositoryName :: Lens' PutImageTagMutability Text
putImageTagMutability_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutImageTagMutability' {Text
repositoryName :: Text
$sel:repositoryName:PutImageTagMutability' :: PutImageTagMutability -> Text
repositoryName} -> Text
repositoryName) (\s :: PutImageTagMutability
s@PutImageTagMutability' {} Text
a -> PutImageTagMutability
s {$sel:repositoryName:PutImageTagMutability' :: Text
repositoryName = Text
a} :: PutImageTagMutability)

-- | The tag mutability setting for the repository. If @MUTABLE@ is
-- specified, image tags can be overwritten. If @IMMUTABLE@ is specified,
-- all image tags within the repository will be immutable which will
-- prevent them from being overwritten.
putImageTagMutability_imageTagMutability :: Lens.Lens' PutImageTagMutability ImageTagMutability
putImageTagMutability_imageTagMutability :: Lens' PutImageTagMutability ImageTagMutability
putImageTagMutability_imageTagMutability = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutImageTagMutability' {ImageTagMutability
imageTagMutability :: ImageTagMutability
$sel:imageTagMutability:PutImageTagMutability' :: PutImageTagMutability -> ImageTagMutability
imageTagMutability} -> ImageTagMutability
imageTagMutability) (\s :: PutImageTagMutability
s@PutImageTagMutability' {} ImageTagMutability
a -> PutImageTagMutability
s {$sel:imageTagMutability:PutImageTagMutability' :: ImageTagMutability
imageTagMutability = ImageTagMutability
a} :: PutImageTagMutability)

instance Core.AWSRequest PutImageTagMutability where
  type
    AWSResponse PutImageTagMutability =
      PutImageTagMutabilityResponse
  request :: (Service -> Service)
-> PutImageTagMutability -> Request PutImageTagMutability
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 PutImageTagMutability
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutImageTagMutability)))
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 ImageTagMutability
-> Maybe Text -> Maybe Text -> Int -> PutImageTagMutabilityResponse
PutImageTagMutabilityResponse'
            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
"imageTagMutability")
            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
"registryId")
            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
"repositoryName")
            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 PutImageTagMutability where
  hashWithSalt :: Int -> PutImageTagMutability -> Int
hashWithSalt Int
_salt PutImageTagMutability' {Maybe Text
Text
ImageTagMutability
imageTagMutability :: ImageTagMutability
repositoryName :: Text
registryId :: Maybe Text
$sel:imageTagMutability:PutImageTagMutability' :: PutImageTagMutability -> ImageTagMutability
$sel:repositoryName:PutImageTagMutability' :: PutImageTagMutability -> Text
$sel:registryId:PutImageTagMutability' :: PutImageTagMutability -> Maybe Text
..} =
    Int
_salt
      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` ImageTagMutability
imageTagMutability

instance Prelude.NFData PutImageTagMutability where
  rnf :: PutImageTagMutability -> ()
rnf PutImageTagMutability' {Maybe Text
Text
ImageTagMutability
imageTagMutability :: ImageTagMutability
repositoryName :: Text
registryId :: Maybe Text
$sel:imageTagMutability:PutImageTagMutability' :: PutImageTagMutability -> ImageTagMutability
$sel:repositoryName:PutImageTagMutability' :: PutImageTagMutability -> Text
$sel:registryId:PutImageTagMutability' :: PutImageTagMutability -> Maybe Text
..} =
    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 ImageTagMutability
imageTagMutability

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

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

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

-- | /See:/ 'newPutImageTagMutabilityResponse' smart constructor.
data PutImageTagMutabilityResponse = PutImageTagMutabilityResponse'
  { -- | The image tag mutability setting for the repository.
    PutImageTagMutabilityResponse -> Maybe ImageTagMutability
imageTagMutability :: Prelude.Maybe ImageTagMutability,
    -- | The registry ID associated with the request.
    PutImageTagMutabilityResponse -> Maybe Text
registryId :: Prelude.Maybe Prelude.Text,
    -- | The repository name associated with the request.
    PutImageTagMutabilityResponse -> Maybe Text
repositoryName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PutImageTagMutabilityResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutImageTagMutabilityResponse
-> PutImageTagMutabilityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutImageTagMutabilityResponse
-> PutImageTagMutabilityResponse -> Bool
$c/= :: PutImageTagMutabilityResponse
-> PutImageTagMutabilityResponse -> Bool
== :: PutImageTagMutabilityResponse
-> PutImageTagMutabilityResponse -> Bool
$c== :: PutImageTagMutabilityResponse
-> PutImageTagMutabilityResponse -> Bool
Prelude.Eq, ReadPrec [PutImageTagMutabilityResponse]
ReadPrec PutImageTagMutabilityResponse
Int -> ReadS PutImageTagMutabilityResponse
ReadS [PutImageTagMutabilityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutImageTagMutabilityResponse]
$creadListPrec :: ReadPrec [PutImageTagMutabilityResponse]
readPrec :: ReadPrec PutImageTagMutabilityResponse
$creadPrec :: ReadPrec PutImageTagMutabilityResponse
readList :: ReadS [PutImageTagMutabilityResponse]
$creadList :: ReadS [PutImageTagMutabilityResponse]
readsPrec :: Int -> ReadS PutImageTagMutabilityResponse
$creadsPrec :: Int -> ReadS PutImageTagMutabilityResponse
Prelude.Read, Int -> PutImageTagMutabilityResponse -> ShowS
[PutImageTagMutabilityResponse] -> ShowS
PutImageTagMutabilityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutImageTagMutabilityResponse] -> ShowS
$cshowList :: [PutImageTagMutabilityResponse] -> ShowS
show :: PutImageTagMutabilityResponse -> String
$cshow :: PutImageTagMutabilityResponse -> String
showsPrec :: Int -> PutImageTagMutabilityResponse -> ShowS
$cshowsPrec :: Int -> PutImageTagMutabilityResponse -> ShowS
Prelude.Show, forall x.
Rep PutImageTagMutabilityResponse x
-> PutImageTagMutabilityResponse
forall x.
PutImageTagMutabilityResponse
-> Rep PutImageTagMutabilityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutImageTagMutabilityResponse x
-> PutImageTagMutabilityResponse
$cfrom :: forall x.
PutImageTagMutabilityResponse
-> Rep PutImageTagMutabilityResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutImageTagMutabilityResponse' 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:
--
-- 'imageTagMutability', 'putImageTagMutabilityResponse_imageTagMutability' - The image tag mutability setting for the repository.
--
-- 'registryId', 'putImageTagMutabilityResponse_registryId' - The registry ID associated with the request.
--
-- 'repositoryName', 'putImageTagMutabilityResponse_repositoryName' - The repository name associated with the request.
--
-- 'httpStatus', 'putImageTagMutabilityResponse_httpStatus' - The response's http status code.
newPutImageTagMutabilityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutImageTagMutabilityResponse
newPutImageTagMutabilityResponse :: Int -> PutImageTagMutabilityResponse
newPutImageTagMutabilityResponse Int
pHttpStatus_ =
  PutImageTagMutabilityResponse'
    { $sel:imageTagMutability:PutImageTagMutabilityResponse' :: Maybe ImageTagMutability
imageTagMutability =
        forall a. Maybe a
Prelude.Nothing,
      $sel:registryId:PutImageTagMutabilityResponse' :: Maybe Text
registryId = forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryName:PutImageTagMutabilityResponse' :: Maybe Text
repositoryName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutImageTagMutabilityResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The image tag mutability setting for the repository.
putImageTagMutabilityResponse_imageTagMutability :: Lens.Lens' PutImageTagMutabilityResponse (Prelude.Maybe ImageTagMutability)
putImageTagMutabilityResponse_imageTagMutability :: Lens' PutImageTagMutabilityResponse (Maybe ImageTagMutability)
putImageTagMutabilityResponse_imageTagMutability = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutImageTagMutabilityResponse' {Maybe ImageTagMutability
imageTagMutability :: Maybe ImageTagMutability
$sel:imageTagMutability:PutImageTagMutabilityResponse' :: PutImageTagMutabilityResponse -> Maybe ImageTagMutability
imageTagMutability} -> Maybe ImageTagMutability
imageTagMutability) (\s :: PutImageTagMutabilityResponse
s@PutImageTagMutabilityResponse' {} Maybe ImageTagMutability
a -> PutImageTagMutabilityResponse
s {$sel:imageTagMutability:PutImageTagMutabilityResponse' :: Maybe ImageTagMutability
imageTagMutability = Maybe ImageTagMutability
a} :: PutImageTagMutabilityResponse)

-- | The registry ID associated with the request.
putImageTagMutabilityResponse_registryId :: Lens.Lens' PutImageTagMutabilityResponse (Prelude.Maybe Prelude.Text)
putImageTagMutabilityResponse_registryId :: Lens' PutImageTagMutabilityResponse (Maybe Text)
putImageTagMutabilityResponse_registryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutImageTagMutabilityResponse' {Maybe Text
registryId :: Maybe Text
$sel:registryId:PutImageTagMutabilityResponse' :: PutImageTagMutabilityResponse -> Maybe Text
registryId} -> Maybe Text
registryId) (\s :: PutImageTagMutabilityResponse
s@PutImageTagMutabilityResponse' {} Maybe Text
a -> PutImageTagMutabilityResponse
s {$sel:registryId:PutImageTagMutabilityResponse' :: Maybe Text
registryId = Maybe Text
a} :: PutImageTagMutabilityResponse)

-- | The repository name associated with the request.
putImageTagMutabilityResponse_repositoryName :: Lens.Lens' PutImageTagMutabilityResponse (Prelude.Maybe Prelude.Text)
putImageTagMutabilityResponse_repositoryName :: Lens' PutImageTagMutabilityResponse (Maybe Text)
putImageTagMutabilityResponse_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutImageTagMutabilityResponse' {Maybe Text
repositoryName :: Maybe Text
$sel:repositoryName:PutImageTagMutabilityResponse' :: PutImageTagMutabilityResponse -> Maybe Text
repositoryName} -> Maybe Text
repositoryName) (\s :: PutImageTagMutabilityResponse
s@PutImageTagMutabilityResponse' {} Maybe Text
a -> PutImageTagMutabilityResponse
s {$sel:repositoryName:PutImageTagMutabilityResponse' :: Maybe Text
repositoryName = Maybe Text
a} :: PutImageTagMutabilityResponse)

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

instance Prelude.NFData PutImageTagMutabilityResponse where
  rnf :: PutImageTagMutabilityResponse -> ()
rnf PutImageTagMutabilityResponse' {Int
Maybe Text
Maybe ImageTagMutability
httpStatus :: Int
repositoryName :: Maybe Text
registryId :: Maybe Text
imageTagMutability :: Maybe ImageTagMutability
$sel:httpStatus:PutImageTagMutabilityResponse' :: PutImageTagMutabilityResponse -> Int
$sel:repositoryName:PutImageTagMutabilityResponse' :: PutImageTagMutabilityResponse -> Maybe Text
$sel:registryId:PutImageTagMutabilityResponse' :: PutImageTagMutabilityResponse -> Maybe Text
$sel:imageTagMutability:PutImageTagMutabilityResponse' :: PutImageTagMutabilityResponse -> Maybe ImageTagMutability
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ImageTagMutability
imageTagMutability
      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 Maybe Text
repositoryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus