{-# 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.LabelParameterVersion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- A parameter label is a user-defined alias to help you manage different
-- versions of a parameter. When you modify a parameter, Amazon Web
-- Services Systems Manager automatically saves a new version and
-- increments the version number by one. A label can help you remember the
-- purpose of a parameter when there are multiple versions.
--
-- Parameter labels have the following requirements and restrictions.
--
-- -   A version of a parameter can have a maximum of 10 labels.
--
-- -   You can\'t attach the same label to different versions of the same
--     parameter. For example, if version 1 has the label Production, then
--     you can\'t attach Production to version 2.
--
-- -   You can move a label from one version of a parameter to another.
--
-- -   You can\'t create a label when you create a new parameter. You must
--     attach a label to a specific version of a parameter.
--
-- -   If you no longer want to use a parameter label, then you can either
--     delete it or move it to a different version of a parameter.
--
-- -   A label can have a maximum of 100 characters.
--
-- -   Labels can contain letters (case sensitive), numbers, periods (.),
--     hyphens (-), or underscores (_).
--
-- -   Labels can\'t begin with a number, \"@aws@\" or \"@ssm@\" (not case
--     sensitive). If a label fails to meet these requirements, then the
--     label isn\'t associated with a parameter and the system displays it
--     in the list of InvalidLabels.
module Amazonka.SSM.LabelParameterVersion
  ( -- * Creating a Request
    LabelParameterVersion (..),
    newLabelParameterVersion,

    -- * Request Lenses
    labelParameterVersion_parameterVersion,
    labelParameterVersion_name,
    labelParameterVersion_labels,

    -- * Destructuring the Response
    LabelParameterVersionResponse (..),
    newLabelParameterVersionResponse,

    -- * Response Lenses
    labelParameterVersionResponse_invalidLabels,
    labelParameterVersionResponse_parameterVersion,
    labelParameterVersionResponse_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:/ 'newLabelParameterVersion' smart constructor.
data LabelParameterVersion = LabelParameterVersion'
  { -- | The specific version of the parameter on which you want to attach one or
    -- more labels. If no version is specified, the system attaches the label
    -- to the latest version.
    LabelParameterVersion -> Maybe Integer
parameterVersion :: Prelude.Maybe Prelude.Integer,
    -- | The parameter name on which you want to attach one or more labels.
    LabelParameterVersion -> Text
name :: Prelude.Text,
    -- | One or more labels to attach to the specified parameter version.
    LabelParameterVersion -> NonEmpty Text
labels :: Prelude.NonEmpty Prelude.Text
  }
  deriving (LabelParameterVersion -> LabelParameterVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LabelParameterVersion -> LabelParameterVersion -> Bool
$c/= :: LabelParameterVersion -> LabelParameterVersion -> Bool
== :: LabelParameterVersion -> LabelParameterVersion -> Bool
$c== :: LabelParameterVersion -> LabelParameterVersion -> Bool
Prelude.Eq, ReadPrec [LabelParameterVersion]
ReadPrec LabelParameterVersion
Int -> ReadS LabelParameterVersion
ReadS [LabelParameterVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LabelParameterVersion]
$creadListPrec :: ReadPrec [LabelParameterVersion]
readPrec :: ReadPrec LabelParameterVersion
$creadPrec :: ReadPrec LabelParameterVersion
readList :: ReadS [LabelParameterVersion]
$creadList :: ReadS [LabelParameterVersion]
readsPrec :: Int -> ReadS LabelParameterVersion
$creadsPrec :: Int -> ReadS LabelParameterVersion
Prelude.Read, Int -> LabelParameterVersion -> ShowS
[LabelParameterVersion] -> ShowS
LabelParameterVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LabelParameterVersion] -> ShowS
$cshowList :: [LabelParameterVersion] -> ShowS
show :: LabelParameterVersion -> String
$cshow :: LabelParameterVersion -> String
showsPrec :: Int -> LabelParameterVersion -> ShowS
$cshowsPrec :: Int -> LabelParameterVersion -> ShowS
Prelude.Show, forall x. Rep LabelParameterVersion x -> LabelParameterVersion
forall x. LabelParameterVersion -> Rep LabelParameterVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LabelParameterVersion x -> LabelParameterVersion
$cfrom :: forall x. LabelParameterVersion -> Rep LabelParameterVersion x
Prelude.Generic)

-- |
-- Create a value of 'LabelParameterVersion' 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:
--
-- 'parameterVersion', 'labelParameterVersion_parameterVersion' - The specific version of the parameter on which you want to attach one or
-- more labels. If no version is specified, the system attaches the label
-- to the latest version.
--
-- 'name', 'labelParameterVersion_name' - The parameter name on which you want to attach one or more labels.
--
-- 'labels', 'labelParameterVersion_labels' - One or more labels to attach to the specified parameter version.
newLabelParameterVersion ::
  -- | 'name'
  Prelude.Text ->
  -- | 'labels'
  Prelude.NonEmpty Prelude.Text ->
  LabelParameterVersion
newLabelParameterVersion :: Text -> NonEmpty Text -> LabelParameterVersion
newLabelParameterVersion Text
pName_ NonEmpty Text
pLabels_ =
  LabelParameterVersion'
    { $sel:parameterVersion:LabelParameterVersion' :: Maybe Integer
parameterVersion =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:LabelParameterVersion' :: Text
name = Text
pName_,
      $sel:labels:LabelParameterVersion' :: 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 specific version of the parameter on which you want to attach one or
-- more labels. If no version is specified, the system attaches the label
-- to the latest version.
labelParameterVersion_parameterVersion :: Lens.Lens' LabelParameterVersion (Prelude.Maybe Prelude.Integer)
labelParameterVersion_parameterVersion :: Lens' LabelParameterVersion (Maybe Integer)
labelParameterVersion_parameterVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LabelParameterVersion' {Maybe Integer
parameterVersion :: Maybe Integer
$sel:parameterVersion:LabelParameterVersion' :: LabelParameterVersion -> Maybe Integer
parameterVersion} -> Maybe Integer
parameterVersion) (\s :: LabelParameterVersion
s@LabelParameterVersion' {} Maybe Integer
a -> LabelParameterVersion
s {$sel:parameterVersion:LabelParameterVersion' :: Maybe Integer
parameterVersion = Maybe Integer
a} :: LabelParameterVersion)

-- | The parameter name on which you want to attach one or more labels.
labelParameterVersion_name :: Lens.Lens' LabelParameterVersion Prelude.Text
labelParameterVersion_name :: Lens' LabelParameterVersion Text
labelParameterVersion_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LabelParameterVersion' {Text
name :: Text
$sel:name:LabelParameterVersion' :: LabelParameterVersion -> Text
name} -> Text
name) (\s :: LabelParameterVersion
s@LabelParameterVersion' {} Text
a -> LabelParameterVersion
s {$sel:name:LabelParameterVersion' :: Text
name = Text
a} :: LabelParameterVersion)

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

instance Prelude.NFData LabelParameterVersion where
  rnf :: LabelParameterVersion -> ()
rnf LabelParameterVersion' {Maybe Integer
NonEmpty Text
Text
labels :: NonEmpty Text
name :: Text
parameterVersion :: Maybe Integer
$sel:labels:LabelParameterVersion' :: LabelParameterVersion -> NonEmpty Text
$sel:name:LabelParameterVersion' :: LabelParameterVersion -> Text
$sel:parameterVersion:LabelParameterVersion' :: LabelParameterVersion -> Maybe Integer
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
parameterVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 NonEmpty Text
labels

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

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

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

-- | /See:/ 'newLabelParameterVersionResponse' smart constructor.
data LabelParameterVersionResponse = LabelParameterVersionResponse'
  { -- | The label doesn\'t meet the requirements. For information about
    -- parameter label requirements, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/sysman-paramstore-labels.html Labeling parameters>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    LabelParameterVersionResponse -> Maybe (NonEmpty Text)
invalidLabels :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The version of the parameter that has been labeled.
    LabelParameterVersionResponse -> Maybe Integer
parameterVersion :: Prelude.Maybe Prelude.Integer,
    -- | The response's http status code.
    LabelParameterVersionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (LabelParameterVersionResponse
-> LabelParameterVersionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LabelParameterVersionResponse
-> LabelParameterVersionResponse -> Bool
$c/= :: LabelParameterVersionResponse
-> LabelParameterVersionResponse -> Bool
== :: LabelParameterVersionResponse
-> LabelParameterVersionResponse -> Bool
$c== :: LabelParameterVersionResponse
-> LabelParameterVersionResponse -> Bool
Prelude.Eq, ReadPrec [LabelParameterVersionResponse]
ReadPrec LabelParameterVersionResponse
Int -> ReadS LabelParameterVersionResponse
ReadS [LabelParameterVersionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LabelParameterVersionResponse]
$creadListPrec :: ReadPrec [LabelParameterVersionResponse]
readPrec :: ReadPrec LabelParameterVersionResponse
$creadPrec :: ReadPrec LabelParameterVersionResponse
readList :: ReadS [LabelParameterVersionResponse]
$creadList :: ReadS [LabelParameterVersionResponse]
readsPrec :: Int -> ReadS LabelParameterVersionResponse
$creadsPrec :: Int -> ReadS LabelParameterVersionResponse
Prelude.Read, Int -> LabelParameterVersionResponse -> ShowS
[LabelParameterVersionResponse] -> ShowS
LabelParameterVersionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LabelParameterVersionResponse] -> ShowS
$cshowList :: [LabelParameterVersionResponse] -> ShowS
show :: LabelParameterVersionResponse -> String
$cshow :: LabelParameterVersionResponse -> String
showsPrec :: Int -> LabelParameterVersionResponse -> ShowS
$cshowsPrec :: Int -> LabelParameterVersionResponse -> ShowS
Prelude.Show, forall x.
Rep LabelParameterVersionResponse x
-> LabelParameterVersionResponse
forall x.
LabelParameterVersionResponse
-> Rep LabelParameterVersionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep LabelParameterVersionResponse x
-> LabelParameterVersionResponse
$cfrom :: forall x.
LabelParameterVersionResponse
-> Rep LabelParameterVersionResponse x
Prelude.Generic)

-- |
-- Create a value of 'LabelParameterVersionResponse' 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', 'labelParameterVersionResponse_invalidLabels' - The label doesn\'t meet the requirements. For information about
-- parameter label requirements, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/sysman-paramstore-labels.html Labeling parameters>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- 'parameterVersion', 'labelParameterVersionResponse_parameterVersion' - The version of the parameter that has been labeled.
--
-- 'httpStatus', 'labelParameterVersionResponse_httpStatus' - The response's http status code.
newLabelParameterVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  LabelParameterVersionResponse
newLabelParameterVersionResponse :: Int -> LabelParameterVersionResponse
newLabelParameterVersionResponse Int
pHttpStatus_ =
  LabelParameterVersionResponse'
    { $sel:invalidLabels:LabelParameterVersionResponse' :: Maybe (NonEmpty Text)
invalidLabels =
        forall a. Maybe a
Prelude.Nothing,
      $sel:parameterVersion:LabelParameterVersionResponse' :: Maybe Integer
parameterVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:LabelParameterVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The label doesn\'t meet the requirements. For information about
-- parameter label requirements, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/sysman-paramstore-labels.html Labeling parameters>
-- in the /Amazon Web Services Systems Manager User Guide/.
labelParameterVersionResponse_invalidLabels :: Lens.Lens' LabelParameterVersionResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
labelParameterVersionResponse_invalidLabels :: Lens' LabelParameterVersionResponse (Maybe (NonEmpty Text))
labelParameterVersionResponse_invalidLabels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LabelParameterVersionResponse' {Maybe (NonEmpty Text)
invalidLabels :: Maybe (NonEmpty Text)
$sel:invalidLabels:LabelParameterVersionResponse' :: LabelParameterVersionResponse -> Maybe (NonEmpty Text)
invalidLabels} -> Maybe (NonEmpty Text)
invalidLabels) (\s :: LabelParameterVersionResponse
s@LabelParameterVersionResponse' {} Maybe (NonEmpty Text)
a -> LabelParameterVersionResponse
s {$sel:invalidLabels:LabelParameterVersionResponse' :: Maybe (NonEmpty Text)
invalidLabels = Maybe (NonEmpty Text)
a} :: LabelParameterVersionResponse) 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 version of the parameter that has been labeled.
labelParameterVersionResponse_parameterVersion :: Lens.Lens' LabelParameterVersionResponse (Prelude.Maybe Prelude.Integer)
labelParameterVersionResponse_parameterVersion :: Lens' LabelParameterVersionResponse (Maybe Integer)
labelParameterVersionResponse_parameterVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LabelParameterVersionResponse' {Maybe Integer
parameterVersion :: Maybe Integer
$sel:parameterVersion:LabelParameterVersionResponse' :: LabelParameterVersionResponse -> Maybe Integer
parameterVersion} -> Maybe Integer
parameterVersion) (\s :: LabelParameterVersionResponse
s@LabelParameterVersionResponse' {} Maybe Integer
a -> LabelParameterVersionResponse
s {$sel:parameterVersion:LabelParameterVersionResponse' :: Maybe Integer
parameterVersion = Maybe Integer
a} :: LabelParameterVersionResponse)

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

instance Prelude.NFData LabelParameterVersionResponse where
  rnf :: LabelParameterVersionResponse -> ()
rnf LabelParameterVersionResponse' {Int
Maybe Integer
Maybe (NonEmpty Text)
httpStatus :: Int
parameterVersion :: Maybe Integer
invalidLabels :: Maybe (NonEmpty Text)
$sel:httpStatus:LabelParameterVersionResponse' :: LabelParameterVersionResponse -> Int
$sel:parameterVersion:LabelParameterVersionResponse' :: LabelParameterVersionResponse -> Maybe Integer
$sel:invalidLabels:LabelParameterVersionResponse' :: LabelParameterVersionResponse -> 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 Integer
parameterVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus