{-# 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.SSM.UnlabelParameterVersion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Remove a label or labels from a parameter.
module Amazonka.SSM.UnlabelParameterVersion
  ( -- * Creating a Request
    UnlabelParameterVersion (..),
    newUnlabelParameterVersion,

    -- * Request Lenses
    unlabelParameterVersion_name,
    unlabelParameterVersion_parameterVersion,
    unlabelParameterVersion_labels,

    -- * Destructuring the Response
    UnlabelParameterVersionResponse (..),
    newUnlabelParameterVersionResponse,

    -- * Response Lenses
    unlabelParameterVersionResponse_invalidLabels,
    unlabelParameterVersionResponse_removedLabels,
    unlabelParameterVersionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUnlabelParameterVersion' smart constructor.
data UnlabelParameterVersion = UnlabelParameterVersion'
  { -- | The name of the parameter from which you want to delete one or more
    -- labels.
    UnlabelParameterVersion -> Text
name :: Prelude.Text,
    -- | The specific version of the parameter which you want to delete one or
    -- more labels from. If it isn\'t present, the call will fail.
    UnlabelParameterVersion -> Integer
parameterVersion :: Prelude.Integer,
    -- | One or more labels to delete from the specified parameter version.
    UnlabelParameterVersion -> NonEmpty Text
labels :: Prelude.NonEmpty Prelude.Text
  }
  deriving (UnlabelParameterVersion -> UnlabelParameterVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnlabelParameterVersion -> UnlabelParameterVersion -> Bool
$c/= :: UnlabelParameterVersion -> UnlabelParameterVersion -> Bool
== :: UnlabelParameterVersion -> UnlabelParameterVersion -> Bool
$c== :: UnlabelParameterVersion -> UnlabelParameterVersion -> Bool
Prelude.Eq, ReadPrec [UnlabelParameterVersion]
ReadPrec UnlabelParameterVersion
Int -> ReadS UnlabelParameterVersion
ReadS [UnlabelParameterVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnlabelParameterVersion]
$creadListPrec :: ReadPrec [UnlabelParameterVersion]
readPrec :: ReadPrec UnlabelParameterVersion
$creadPrec :: ReadPrec UnlabelParameterVersion
readList :: ReadS [UnlabelParameterVersion]
$creadList :: ReadS [UnlabelParameterVersion]
readsPrec :: Int -> ReadS UnlabelParameterVersion
$creadsPrec :: Int -> ReadS UnlabelParameterVersion
Prelude.Read, Int -> UnlabelParameterVersion -> ShowS
[UnlabelParameterVersion] -> ShowS
UnlabelParameterVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnlabelParameterVersion] -> ShowS
$cshowList :: [UnlabelParameterVersion] -> ShowS
show :: UnlabelParameterVersion -> String
$cshow :: UnlabelParameterVersion -> String
showsPrec :: Int -> UnlabelParameterVersion -> ShowS
$cshowsPrec :: Int -> UnlabelParameterVersion -> ShowS
Prelude.Show, forall x. Rep UnlabelParameterVersion x -> UnlabelParameterVersion
forall x. UnlabelParameterVersion -> Rep UnlabelParameterVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnlabelParameterVersion x -> UnlabelParameterVersion
$cfrom :: forall x. UnlabelParameterVersion -> Rep UnlabelParameterVersion x
Prelude.Generic)

-- |
-- Create a value of 'UnlabelParameterVersion' 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:
--
-- 'name', 'unlabelParameterVersion_name' - The name of the parameter from which you want to delete one or more
-- labels.
--
-- 'parameterVersion', 'unlabelParameterVersion_parameterVersion' - The specific version of the parameter which you want to delete one or
-- more labels from. If it isn\'t present, the call will fail.
--
-- 'labels', 'unlabelParameterVersion_labels' - One or more labels to delete from the specified parameter version.
newUnlabelParameterVersion ::
  -- | 'name'
  Prelude.Text ->
  -- | 'parameterVersion'
  Prelude.Integer ->
  -- | 'labels'
  Prelude.NonEmpty Prelude.Text ->
  UnlabelParameterVersion
newUnlabelParameterVersion :: Text -> Integer -> NonEmpty Text -> UnlabelParameterVersion
newUnlabelParameterVersion
  Text
pName_
  Integer
pParameterVersion_
  NonEmpty Text
pLabels_ =
    UnlabelParameterVersion'
      { $sel:name:UnlabelParameterVersion' :: Text
name = Text
pName_,
        $sel:parameterVersion:UnlabelParameterVersion' :: Integer
parameterVersion = Integer
pParameterVersion_,
        $sel:labels:UnlabelParameterVersion' :: NonEmpty Text
labels = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pLabels_
      }

-- | The name of the parameter from which you want to delete one or more
-- labels.
unlabelParameterVersion_name :: Lens.Lens' UnlabelParameterVersion Prelude.Text
unlabelParameterVersion_name :: Lens' UnlabelParameterVersion Text
unlabelParameterVersion_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnlabelParameterVersion' {Text
name :: Text
$sel:name:UnlabelParameterVersion' :: UnlabelParameterVersion -> Text
name} -> Text
name) (\s :: UnlabelParameterVersion
s@UnlabelParameterVersion' {} Text
a -> UnlabelParameterVersion
s {$sel:name:UnlabelParameterVersion' :: Text
name = Text
a} :: UnlabelParameterVersion)

-- | The specific version of the parameter which you want to delete one or
-- more labels from. If it isn\'t present, the call will fail.
unlabelParameterVersion_parameterVersion :: Lens.Lens' UnlabelParameterVersion Prelude.Integer
unlabelParameterVersion_parameterVersion :: Lens' UnlabelParameterVersion Integer
unlabelParameterVersion_parameterVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnlabelParameterVersion' {Integer
parameterVersion :: Integer
$sel:parameterVersion:UnlabelParameterVersion' :: UnlabelParameterVersion -> Integer
parameterVersion} -> Integer
parameterVersion) (\s :: UnlabelParameterVersion
s@UnlabelParameterVersion' {} Integer
a -> UnlabelParameterVersion
s {$sel:parameterVersion:UnlabelParameterVersion' :: Integer
parameterVersion = Integer
a} :: UnlabelParameterVersion)

-- | One or more labels to delete from the specified parameter version.
unlabelParameterVersion_labels :: Lens.Lens' UnlabelParameterVersion (Prelude.NonEmpty Prelude.Text)
unlabelParameterVersion_labels :: Lens' UnlabelParameterVersion (NonEmpty Text)
unlabelParameterVersion_labels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnlabelParameterVersion' {NonEmpty Text
labels :: NonEmpty Text
$sel:labels:UnlabelParameterVersion' :: UnlabelParameterVersion -> NonEmpty Text
labels} -> NonEmpty Text
labels) (\s :: UnlabelParameterVersion
s@UnlabelParameterVersion' {} NonEmpty Text
a -> UnlabelParameterVersion
s {$sel:labels:UnlabelParameterVersion' :: NonEmpty Text
labels = NonEmpty Text
a} :: UnlabelParameterVersion) 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 UnlabelParameterVersion where
  type
    AWSResponse UnlabelParameterVersion =
      UnlabelParameterVersionResponse
  request :: (Service -> Service)
-> UnlabelParameterVersion -> Request UnlabelParameterVersion
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 UnlabelParameterVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UnlabelParameterVersion)))
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 (NonEmpty Text)
-> Maybe (NonEmpty Text) -> Int -> UnlabelParameterVersionResponse
UnlabelParameterVersionResponse'
            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
"InvalidLabels")
            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
"RemovedLabels")
            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 UnlabelParameterVersion where
  hashWithSalt :: Int -> UnlabelParameterVersion -> Int
hashWithSalt Int
_salt UnlabelParameterVersion' {Integer
NonEmpty Text
Text
labels :: NonEmpty Text
parameterVersion :: Integer
name :: Text
$sel:labels:UnlabelParameterVersion' :: UnlabelParameterVersion -> NonEmpty Text
$sel:parameterVersion:UnlabelParameterVersion' :: UnlabelParameterVersion -> Integer
$sel:name:UnlabelParameterVersion' :: UnlabelParameterVersion -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Integer
parameterVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
labels

instance Prelude.NFData UnlabelParameterVersion where
  rnf :: UnlabelParameterVersion -> ()
rnf UnlabelParameterVersion' {Integer
NonEmpty Text
Text
labels :: NonEmpty Text
parameterVersion :: Integer
name :: Text
$sel:labels:UnlabelParameterVersion' :: UnlabelParameterVersion -> NonEmpty Text
$sel:parameterVersion:UnlabelParameterVersion' :: UnlabelParameterVersion -> Integer
$sel:name:UnlabelParameterVersion' :: UnlabelParameterVersion -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
parameterVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
labels

instance Data.ToHeaders UnlabelParameterVersion where
  toHeaders :: UnlabelParameterVersion -> 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
"AmazonSSM.UnlabelParameterVersion" ::
                          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 UnlabelParameterVersion where
  toJSON :: UnlabelParameterVersion -> Value
toJSON UnlabelParameterVersion' {Integer
NonEmpty Text
Text
labels :: NonEmpty Text
parameterVersion :: Integer
name :: Text
$sel:labels:UnlabelParameterVersion' :: UnlabelParameterVersion -> NonEmpty Text
$sel:parameterVersion:UnlabelParameterVersion' :: UnlabelParameterVersion -> Integer
$sel:name:UnlabelParameterVersion' :: UnlabelParameterVersion -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ParameterVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Integer
parameterVersion),
            forall a. a -> Maybe a
Prelude.Just (Key
"Labels" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
labels)
          ]
      )

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

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

-- | /See:/ 'newUnlabelParameterVersionResponse' smart constructor.
data UnlabelParameterVersionResponse = UnlabelParameterVersionResponse'
  { -- | The labels that aren\'t attached to the given parameter version.
    UnlabelParameterVersionResponse -> Maybe (NonEmpty Text)
invalidLabels :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | A list of all labels deleted from the parameter.
    UnlabelParameterVersionResponse -> Maybe (NonEmpty Text)
removedLabels :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The response's http status code.
    UnlabelParameterVersionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UnlabelParameterVersionResponse
-> UnlabelParameterVersionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnlabelParameterVersionResponse
-> UnlabelParameterVersionResponse -> Bool
$c/= :: UnlabelParameterVersionResponse
-> UnlabelParameterVersionResponse -> Bool
== :: UnlabelParameterVersionResponse
-> UnlabelParameterVersionResponse -> Bool
$c== :: UnlabelParameterVersionResponse
-> UnlabelParameterVersionResponse -> Bool
Prelude.Eq, ReadPrec [UnlabelParameterVersionResponse]
ReadPrec UnlabelParameterVersionResponse
Int -> ReadS UnlabelParameterVersionResponse
ReadS [UnlabelParameterVersionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnlabelParameterVersionResponse]
$creadListPrec :: ReadPrec [UnlabelParameterVersionResponse]
readPrec :: ReadPrec UnlabelParameterVersionResponse
$creadPrec :: ReadPrec UnlabelParameterVersionResponse
readList :: ReadS [UnlabelParameterVersionResponse]
$creadList :: ReadS [UnlabelParameterVersionResponse]
readsPrec :: Int -> ReadS UnlabelParameterVersionResponse
$creadsPrec :: Int -> ReadS UnlabelParameterVersionResponse
Prelude.Read, Int -> UnlabelParameterVersionResponse -> ShowS
[UnlabelParameterVersionResponse] -> ShowS
UnlabelParameterVersionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnlabelParameterVersionResponse] -> ShowS
$cshowList :: [UnlabelParameterVersionResponse] -> ShowS
show :: UnlabelParameterVersionResponse -> String
$cshow :: UnlabelParameterVersionResponse -> String
showsPrec :: Int -> UnlabelParameterVersionResponse -> ShowS
$cshowsPrec :: Int -> UnlabelParameterVersionResponse -> ShowS
Prelude.Show, forall x.
Rep UnlabelParameterVersionResponse x
-> UnlabelParameterVersionResponse
forall x.
UnlabelParameterVersionResponse
-> Rep UnlabelParameterVersionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UnlabelParameterVersionResponse x
-> UnlabelParameterVersionResponse
$cfrom :: forall x.
UnlabelParameterVersionResponse
-> Rep UnlabelParameterVersionResponse x
Prelude.Generic)

-- |
-- Create a value of 'UnlabelParameterVersionResponse' 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:
--
-- 'invalidLabels', 'unlabelParameterVersionResponse_invalidLabels' - The labels that aren\'t attached to the given parameter version.
--
-- 'removedLabels', 'unlabelParameterVersionResponse_removedLabels' - A list of all labels deleted from the parameter.
--
-- 'httpStatus', 'unlabelParameterVersionResponse_httpStatus' - The response's http status code.
newUnlabelParameterVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UnlabelParameterVersionResponse
newUnlabelParameterVersionResponse :: Int -> UnlabelParameterVersionResponse
newUnlabelParameterVersionResponse Int
pHttpStatus_ =
  UnlabelParameterVersionResponse'
    { $sel:invalidLabels:UnlabelParameterVersionResponse' :: Maybe (NonEmpty Text)
invalidLabels =
        forall a. Maybe a
Prelude.Nothing,
      $sel:removedLabels:UnlabelParameterVersionResponse' :: Maybe (NonEmpty Text)
removedLabels = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UnlabelParameterVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The labels that aren\'t attached to the given parameter version.
unlabelParameterVersionResponse_invalidLabels :: Lens.Lens' UnlabelParameterVersionResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
unlabelParameterVersionResponse_invalidLabels :: Lens' UnlabelParameterVersionResponse (Maybe (NonEmpty Text))
unlabelParameterVersionResponse_invalidLabels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnlabelParameterVersionResponse' {Maybe (NonEmpty Text)
invalidLabels :: Maybe (NonEmpty Text)
$sel:invalidLabels:UnlabelParameterVersionResponse' :: UnlabelParameterVersionResponse -> Maybe (NonEmpty Text)
invalidLabels} -> Maybe (NonEmpty Text)
invalidLabels) (\s :: UnlabelParameterVersionResponse
s@UnlabelParameterVersionResponse' {} Maybe (NonEmpty Text)
a -> UnlabelParameterVersionResponse
s {$sel:invalidLabels:UnlabelParameterVersionResponse' :: Maybe (NonEmpty Text)
invalidLabels = Maybe (NonEmpty Text)
a} :: UnlabelParameterVersionResponse) 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 all labels deleted from the parameter.
unlabelParameterVersionResponse_removedLabels :: Lens.Lens' UnlabelParameterVersionResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
unlabelParameterVersionResponse_removedLabels :: Lens' UnlabelParameterVersionResponse (Maybe (NonEmpty Text))
unlabelParameterVersionResponse_removedLabels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnlabelParameterVersionResponse' {Maybe (NonEmpty Text)
removedLabels :: Maybe (NonEmpty Text)
$sel:removedLabels:UnlabelParameterVersionResponse' :: UnlabelParameterVersionResponse -> Maybe (NonEmpty Text)
removedLabels} -> Maybe (NonEmpty Text)
removedLabels) (\s :: UnlabelParameterVersionResponse
s@UnlabelParameterVersionResponse' {} Maybe (NonEmpty Text)
a -> UnlabelParameterVersionResponse
s {$sel:removedLabels:UnlabelParameterVersionResponse' :: Maybe (NonEmpty Text)
removedLabels = Maybe (NonEmpty Text)
a} :: UnlabelParameterVersionResponse) 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.
unlabelParameterVersionResponse_httpStatus :: Lens.Lens' UnlabelParameterVersionResponse Prelude.Int
unlabelParameterVersionResponse_httpStatus :: Lens' UnlabelParameterVersionResponse Int
unlabelParameterVersionResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnlabelParameterVersionResponse' {Int
httpStatus :: Int
$sel:httpStatus:UnlabelParameterVersionResponse' :: UnlabelParameterVersionResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UnlabelParameterVersionResponse
s@UnlabelParameterVersionResponse' {} Int
a -> UnlabelParameterVersionResponse
s {$sel:httpStatus:UnlabelParameterVersionResponse' :: Int
httpStatus = Int
a} :: UnlabelParameterVersionResponse)

instance
  Prelude.NFData
    UnlabelParameterVersionResponse
  where
  rnf :: UnlabelParameterVersionResponse -> ()
rnf UnlabelParameterVersionResponse' {Int
Maybe (NonEmpty Text)
httpStatus :: Int
removedLabels :: Maybe (NonEmpty Text)
invalidLabels :: Maybe (NonEmpty Text)
$sel:httpStatus:UnlabelParameterVersionResponse' :: UnlabelParameterVersionResponse -> Int
$sel:removedLabels:UnlabelParameterVersionResponse' :: UnlabelParameterVersionResponse -> Maybe (NonEmpty Text)
$sel:invalidLabels:UnlabelParameterVersionResponse' :: UnlabelParameterVersionResponse -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
invalidLabels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
removedLabels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus