{-# 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.ElasticBeanstalk.ValidateConfigurationSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Takes a set of configuration settings and either a configuration
-- template or environment, and determines whether those values are valid.
--
-- This action returns a list of messages indicating any errors or warnings
-- associated with the selection of option values.
module Amazonka.ElasticBeanstalk.ValidateConfigurationSettings
  ( -- * Creating a Request
    ValidateConfigurationSettings (..),
    newValidateConfigurationSettings,

    -- * Request Lenses
    validateConfigurationSettings_environmentName,
    validateConfigurationSettings_templateName,
    validateConfigurationSettings_applicationName,
    validateConfigurationSettings_optionSettings,

    -- * Destructuring the Response
    ValidateConfigurationSettingsResponse (..),
    newValidateConfigurationSettingsResponse,

    -- * Response Lenses
    validateConfigurationSettingsResponse_messages,
    validateConfigurationSettingsResponse_httpStatus,
  )
where

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

-- | A list of validation messages for a specified configuration template.
--
-- /See:/ 'newValidateConfigurationSettings' smart constructor.
data ValidateConfigurationSettings = ValidateConfigurationSettings'
  { -- | The name of the environment to validate the settings against.
    --
    -- Condition: You cannot specify both this and a configuration template
    -- name.
    ValidateConfigurationSettings -> Maybe Text
environmentName :: Prelude.Maybe Prelude.Text,
    -- | The name of the configuration template to validate the settings against.
    --
    -- Condition: You cannot specify both this and an environment name.
    ValidateConfigurationSettings -> Maybe Text
templateName :: Prelude.Maybe Prelude.Text,
    -- | The name of the application that the configuration template or
    -- environment belongs to.
    ValidateConfigurationSettings -> Text
applicationName :: Prelude.Text,
    -- | A list of the options and desired values to evaluate.
    ValidateConfigurationSettings -> [ConfigurationOptionSetting]
optionSettings :: [ConfigurationOptionSetting]
  }
  deriving (ValidateConfigurationSettings
-> ValidateConfigurationSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidateConfigurationSettings
-> ValidateConfigurationSettings -> Bool
$c/= :: ValidateConfigurationSettings
-> ValidateConfigurationSettings -> Bool
== :: ValidateConfigurationSettings
-> ValidateConfigurationSettings -> Bool
$c== :: ValidateConfigurationSettings
-> ValidateConfigurationSettings -> Bool
Prelude.Eq, ReadPrec [ValidateConfigurationSettings]
ReadPrec ValidateConfigurationSettings
Int -> ReadS ValidateConfigurationSettings
ReadS [ValidateConfigurationSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ValidateConfigurationSettings]
$creadListPrec :: ReadPrec [ValidateConfigurationSettings]
readPrec :: ReadPrec ValidateConfigurationSettings
$creadPrec :: ReadPrec ValidateConfigurationSettings
readList :: ReadS [ValidateConfigurationSettings]
$creadList :: ReadS [ValidateConfigurationSettings]
readsPrec :: Int -> ReadS ValidateConfigurationSettings
$creadsPrec :: Int -> ReadS ValidateConfigurationSettings
Prelude.Read, Int -> ValidateConfigurationSettings -> ShowS
[ValidateConfigurationSettings] -> ShowS
ValidateConfigurationSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidateConfigurationSettings] -> ShowS
$cshowList :: [ValidateConfigurationSettings] -> ShowS
show :: ValidateConfigurationSettings -> String
$cshow :: ValidateConfigurationSettings -> String
showsPrec :: Int -> ValidateConfigurationSettings -> ShowS
$cshowsPrec :: Int -> ValidateConfigurationSettings -> ShowS
Prelude.Show, forall x.
Rep ValidateConfigurationSettings x
-> ValidateConfigurationSettings
forall x.
ValidateConfigurationSettings
-> Rep ValidateConfigurationSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ValidateConfigurationSettings x
-> ValidateConfigurationSettings
$cfrom :: forall x.
ValidateConfigurationSettings
-> Rep ValidateConfigurationSettings x
Prelude.Generic)

-- |
-- Create a value of 'ValidateConfigurationSettings' 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:
--
-- 'environmentName', 'validateConfigurationSettings_environmentName' - The name of the environment to validate the settings against.
--
-- Condition: You cannot specify both this and a configuration template
-- name.
--
-- 'templateName', 'validateConfigurationSettings_templateName' - The name of the configuration template to validate the settings against.
--
-- Condition: You cannot specify both this and an environment name.
--
-- 'applicationName', 'validateConfigurationSettings_applicationName' - The name of the application that the configuration template or
-- environment belongs to.
--
-- 'optionSettings', 'validateConfigurationSettings_optionSettings' - A list of the options and desired values to evaluate.
newValidateConfigurationSettings ::
  -- | 'applicationName'
  Prelude.Text ->
  ValidateConfigurationSettings
newValidateConfigurationSettings :: Text -> ValidateConfigurationSettings
newValidateConfigurationSettings Text
pApplicationName_ =
  ValidateConfigurationSettings'
    { $sel:environmentName:ValidateConfigurationSettings' :: Maybe Text
environmentName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:templateName:ValidateConfigurationSettings' :: Maybe Text
templateName = forall a. Maybe a
Prelude.Nothing,
      $sel:applicationName:ValidateConfigurationSettings' :: Text
applicationName = Text
pApplicationName_,
      $sel:optionSettings:ValidateConfigurationSettings' :: [ConfigurationOptionSetting]
optionSettings = forall a. Monoid a => a
Prelude.mempty
    }

-- | The name of the environment to validate the settings against.
--
-- Condition: You cannot specify both this and a configuration template
-- name.
validateConfigurationSettings_environmentName :: Lens.Lens' ValidateConfigurationSettings (Prelude.Maybe Prelude.Text)
validateConfigurationSettings_environmentName :: Lens' ValidateConfigurationSettings (Maybe Text)
validateConfigurationSettings_environmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateConfigurationSettings' {Maybe Text
environmentName :: Maybe Text
$sel:environmentName:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> Maybe Text
environmentName} -> Maybe Text
environmentName) (\s :: ValidateConfigurationSettings
s@ValidateConfigurationSettings' {} Maybe Text
a -> ValidateConfigurationSettings
s {$sel:environmentName:ValidateConfigurationSettings' :: Maybe Text
environmentName = Maybe Text
a} :: ValidateConfigurationSettings)

-- | The name of the configuration template to validate the settings against.
--
-- Condition: You cannot specify both this and an environment name.
validateConfigurationSettings_templateName :: Lens.Lens' ValidateConfigurationSettings (Prelude.Maybe Prelude.Text)
validateConfigurationSettings_templateName :: Lens' ValidateConfigurationSettings (Maybe Text)
validateConfigurationSettings_templateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateConfigurationSettings' {Maybe Text
templateName :: Maybe Text
$sel:templateName:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> Maybe Text
templateName} -> Maybe Text
templateName) (\s :: ValidateConfigurationSettings
s@ValidateConfigurationSettings' {} Maybe Text
a -> ValidateConfigurationSettings
s {$sel:templateName:ValidateConfigurationSettings' :: Maybe Text
templateName = Maybe Text
a} :: ValidateConfigurationSettings)

-- | The name of the application that the configuration template or
-- environment belongs to.
validateConfigurationSettings_applicationName :: Lens.Lens' ValidateConfigurationSettings Prelude.Text
validateConfigurationSettings_applicationName :: Lens' ValidateConfigurationSettings Text
validateConfigurationSettings_applicationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateConfigurationSettings' {Text
applicationName :: Text
$sel:applicationName:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> Text
applicationName} -> Text
applicationName) (\s :: ValidateConfigurationSettings
s@ValidateConfigurationSettings' {} Text
a -> ValidateConfigurationSettings
s {$sel:applicationName:ValidateConfigurationSettings' :: Text
applicationName = Text
a} :: ValidateConfigurationSettings)

-- | A list of the options and desired values to evaluate.
validateConfigurationSettings_optionSettings :: Lens.Lens' ValidateConfigurationSettings [ConfigurationOptionSetting]
validateConfigurationSettings_optionSettings :: Lens' ValidateConfigurationSettings [ConfigurationOptionSetting]
validateConfigurationSettings_optionSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateConfigurationSettings' {[ConfigurationOptionSetting]
optionSettings :: [ConfigurationOptionSetting]
$sel:optionSettings:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> [ConfigurationOptionSetting]
optionSettings} -> [ConfigurationOptionSetting]
optionSettings) (\s :: ValidateConfigurationSettings
s@ValidateConfigurationSettings' {} [ConfigurationOptionSetting]
a -> ValidateConfigurationSettings
s {$sel:optionSettings:ValidateConfigurationSettings' :: [ConfigurationOptionSetting]
optionSettings = [ConfigurationOptionSetting]
a} :: ValidateConfigurationSettings) 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
    ValidateConfigurationSettings
  where
  type
    AWSResponse ValidateConfigurationSettings =
      ValidateConfigurationSettingsResponse
  request :: (Service -> Service)
-> ValidateConfigurationSettings
-> Request ValidateConfigurationSettings
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ValidateConfigurationSettings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ValidateConfigurationSettings)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"ValidateConfigurationSettingsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [ValidationMessage]
-> Int -> ValidateConfigurationSettingsResponse
ValidateConfigurationSettingsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Messages"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            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
    ValidateConfigurationSettings
  where
  hashWithSalt :: Int -> ValidateConfigurationSettings -> Int
hashWithSalt Int
_salt ValidateConfigurationSettings' {[ConfigurationOptionSetting]
Maybe Text
Text
optionSettings :: [ConfigurationOptionSetting]
applicationName :: Text
templateName :: Maybe Text
environmentName :: Maybe Text
$sel:optionSettings:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> [ConfigurationOptionSetting]
$sel:applicationName:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> Text
$sel:templateName:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> Maybe Text
$sel:environmentName:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
environmentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [ConfigurationOptionSetting]
optionSettings

instance Prelude.NFData ValidateConfigurationSettings where
  rnf :: ValidateConfigurationSettings -> ()
rnf ValidateConfigurationSettings' {[ConfigurationOptionSetting]
Maybe Text
Text
optionSettings :: [ConfigurationOptionSetting]
applicationName :: Text
templateName :: Maybe Text
environmentName :: Maybe Text
$sel:optionSettings:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> [ConfigurationOptionSetting]
$sel:applicationName:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> Text
$sel:templateName:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> Maybe Text
$sel:environmentName:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
environmentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ConfigurationOptionSetting]
optionSettings

instance Data.ToHeaders ValidateConfigurationSettings where
  toHeaders :: ValidateConfigurationSettings -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ValidateConfigurationSettings where
  toQuery :: ValidateConfigurationSettings -> QueryString
toQuery ValidateConfigurationSettings' {[ConfigurationOptionSetting]
Maybe Text
Text
optionSettings :: [ConfigurationOptionSetting]
applicationName :: Text
templateName :: Maybe Text
environmentName :: Maybe Text
$sel:optionSettings:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> [ConfigurationOptionSetting]
$sel:applicationName:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> Text
$sel:templateName:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> Maybe Text
$sel:environmentName:ValidateConfigurationSettings' :: ValidateConfigurationSettings -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ValidateConfigurationSettings" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-12-01" :: Prelude.ByteString),
        ByteString
"EnvironmentName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
environmentName,
        ByteString
"TemplateName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
templateName,
        ByteString
"ApplicationName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
applicationName,
        ByteString
"OptionSettings"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [ConfigurationOptionSetting]
optionSettings
      ]

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

-- |
-- Create a value of 'ValidateConfigurationSettingsResponse' 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:
--
-- 'messages', 'validateConfigurationSettingsResponse_messages' - A list of ValidationMessage.
--
-- 'httpStatus', 'validateConfigurationSettingsResponse_httpStatus' - The response's http status code.
newValidateConfigurationSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ValidateConfigurationSettingsResponse
newValidateConfigurationSettingsResponse :: Int -> ValidateConfigurationSettingsResponse
newValidateConfigurationSettingsResponse Int
pHttpStatus_ =
  ValidateConfigurationSettingsResponse'
    { $sel:messages:ValidateConfigurationSettingsResponse' :: Maybe [ValidationMessage]
messages =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ValidateConfigurationSettingsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of ValidationMessage.
validateConfigurationSettingsResponse_messages :: Lens.Lens' ValidateConfigurationSettingsResponse (Prelude.Maybe [ValidationMessage])
validateConfigurationSettingsResponse_messages :: Lens'
  ValidateConfigurationSettingsResponse (Maybe [ValidationMessage])
validateConfigurationSettingsResponse_messages = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateConfigurationSettingsResponse' {Maybe [ValidationMessage]
messages :: Maybe [ValidationMessage]
$sel:messages:ValidateConfigurationSettingsResponse' :: ValidateConfigurationSettingsResponse -> Maybe [ValidationMessage]
messages} -> Maybe [ValidationMessage]
messages) (\s :: ValidateConfigurationSettingsResponse
s@ValidateConfigurationSettingsResponse' {} Maybe [ValidationMessage]
a -> ValidateConfigurationSettingsResponse
s {$sel:messages:ValidateConfigurationSettingsResponse' :: Maybe [ValidationMessage]
messages = Maybe [ValidationMessage]
a} :: ValidateConfigurationSettingsResponse) 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.
validateConfigurationSettingsResponse_httpStatus :: Lens.Lens' ValidateConfigurationSettingsResponse Prelude.Int
validateConfigurationSettingsResponse_httpStatus :: Lens' ValidateConfigurationSettingsResponse Int
validateConfigurationSettingsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ValidateConfigurationSettingsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ValidateConfigurationSettingsResponse' :: ValidateConfigurationSettingsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ValidateConfigurationSettingsResponse
s@ValidateConfigurationSettingsResponse' {} Int
a -> ValidateConfigurationSettingsResponse
s {$sel:httpStatus:ValidateConfigurationSettingsResponse' :: Int
httpStatus = Int
a} :: ValidateConfigurationSettingsResponse)

instance
  Prelude.NFData
    ValidateConfigurationSettingsResponse
  where
  rnf :: ValidateConfigurationSettingsResponse -> ()
rnf ValidateConfigurationSettingsResponse' {Int
Maybe [ValidationMessage]
httpStatus :: Int
messages :: Maybe [ValidationMessage]
$sel:httpStatus:ValidateConfigurationSettingsResponse' :: ValidateConfigurationSettingsResponse -> Int
$sel:messages:ValidateConfigurationSettingsResponse' :: ValidateConfigurationSettingsResponse -> Maybe [ValidationMessage]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ValidationMessage]
messages
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus