{-# 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.OpsWorksCM.ExportServerEngineAttribute
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Exports a specified server engine attribute as a base64-encoded string.
-- For example, you can export user data that you can use in EC2 to
-- associate nodes with a server.
--
-- This operation is synchronous.
--
-- A @ValidationException@ is raised when parameters of the request are not
-- valid. A @ResourceNotFoundException@ is thrown when the server does not
-- exist. An @InvalidStateException@ is thrown when the server is in any of
-- the following states: CREATING, TERMINATED, FAILED or DELETING.
module Amazonka.OpsWorksCM.ExportServerEngineAttribute
  ( -- * Creating a Request
    ExportServerEngineAttribute (..),
    newExportServerEngineAttribute,

    -- * Request Lenses
    exportServerEngineAttribute_inputAttributes,
    exportServerEngineAttribute_exportAttributeName,
    exportServerEngineAttribute_serverName,

    -- * Destructuring the Response
    ExportServerEngineAttributeResponse (..),
    newExportServerEngineAttributeResponse,

    -- * Response Lenses
    exportServerEngineAttributeResponse_engineAttribute,
    exportServerEngineAttributeResponse_serverName,
    exportServerEngineAttributeResponse_httpStatus,
  )
where

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

-- | /See:/ 'newExportServerEngineAttribute' smart constructor.
data ExportServerEngineAttribute = ExportServerEngineAttribute'
  { -- | The list of engine attributes. The list type is @EngineAttribute@. An
    -- @EngineAttribute@ list item is a pair that includes an attribute name
    -- and its value. For the @Userdata@ ExportAttributeName, the following are
    -- supported engine attribute names.
    --
    -- -   __RunList__ In Chef, a list of roles or recipes that are run in the
    --     specified order. In Puppet, this parameter is ignored.
    --
    -- -   __OrganizationName__ In Chef, an organization name. AWS OpsWorks for
    --     Chef Automate always creates the organization @default@. In Puppet,
    --     this parameter is ignored.
    --
    -- -   __NodeEnvironment__ In Chef, a node environment (for example,
    --     development, staging, or one-box). In Puppet, this parameter is
    --     ignored.
    --
    -- -   __NodeClientVersion__ In Chef, the version of the Chef engine (three
    --     numbers separated by dots, such as 13.8.5). If this attribute is
    --     empty, OpsWorks for Chef Automate uses the most current version. In
    --     Puppet, this parameter is ignored.
    ExportServerEngineAttribute -> Maybe [EngineAttribute]
inputAttributes :: Prelude.Maybe [EngineAttribute],
    -- | The name of the export attribute. Currently, the supported export
    -- attribute is @Userdata@. This exports a user data script that includes
    -- parameters and values provided in the @InputAttributes@ list.
    ExportServerEngineAttribute -> Text
exportAttributeName :: Prelude.Text,
    -- | The name of the server from which you are exporting the attribute.
    ExportServerEngineAttribute -> Text
serverName :: Prelude.Text
  }
  deriving (ExportServerEngineAttribute -> ExportServerEngineAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportServerEngineAttribute -> ExportServerEngineAttribute -> Bool
$c/= :: ExportServerEngineAttribute -> ExportServerEngineAttribute -> Bool
== :: ExportServerEngineAttribute -> ExportServerEngineAttribute -> Bool
$c== :: ExportServerEngineAttribute -> ExportServerEngineAttribute -> Bool
Prelude.Eq, Int -> ExportServerEngineAttribute -> ShowS
[ExportServerEngineAttribute] -> ShowS
ExportServerEngineAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportServerEngineAttribute] -> ShowS
$cshowList :: [ExportServerEngineAttribute] -> ShowS
show :: ExportServerEngineAttribute -> String
$cshow :: ExportServerEngineAttribute -> String
showsPrec :: Int -> ExportServerEngineAttribute -> ShowS
$cshowsPrec :: Int -> ExportServerEngineAttribute -> ShowS
Prelude.Show, forall x.
Rep ExportServerEngineAttribute x -> ExportServerEngineAttribute
forall x.
ExportServerEngineAttribute -> Rep ExportServerEngineAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ExportServerEngineAttribute x -> ExportServerEngineAttribute
$cfrom :: forall x.
ExportServerEngineAttribute -> Rep ExportServerEngineAttribute x
Prelude.Generic)

-- |
-- Create a value of 'ExportServerEngineAttribute' 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:
--
-- 'inputAttributes', 'exportServerEngineAttribute_inputAttributes' - The list of engine attributes. The list type is @EngineAttribute@. An
-- @EngineAttribute@ list item is a pair that includes an attribute name
-- and its value. For the @Userdata@ ExportAttributeName, the following are
-- supported engine attribute names.
--
-- -   __RunList__ In Chef, a list of roles or recipes that are run in the
--     specified order. In Puppet, this parameter is ignored.
--
-- -   __OrganizationName__ In Chef, an organization name. AWS OpsWorks for
--     Chef Automate always creates the organization @default@. In Puppet,
--     this parameter is ignored.
--
-- -   __NodeEnvironment__ In Chef, a node environment (for example,
--     development, staging, or one-box). In Puppet, this parameter is
--     ignored.
--
-- -   __NodeClientVersion__ In Chef, the version of the Chef engine (three
--     numbers separated by dots, such as 13.8.5). If this attribute is
--     empty, OpsWorks for Chef Automate uses the most current version. In
--     Puppet, this parameter is ignored.
--
-- 'exportAttributeName', 'exportServerEngineAttribute_exportAttributeName' - The name of the export attribute. Currently, the supported export
-- attribute is @Userdata@. This exports a user data script that includes
-- parameters and values provided in the @InputAttributes@ list.
--
-- 'serverName', 'exportServerEngineAttribute_serverName' - The name of the server from which you are exporting the attribute.
newExportServerEngineAttribute ::
  -- | 'exportAttributeName'
  Prelude.Text ->
  -- | 'serverName'
  Prelude.Text ->
  ExportServerEngineAttribute
newExportServerEngineAttribute :: Text -> Text -> ExportServerEngineAttribute
newExportServerEngineAttribute
  Text
pExportAttributeName_
  Text
pServerName_ =
    ExportServerEngineAttribute'
      { $sel:inputAttributes:ExportServerEngineAttribute' :: Maybe [EngineAttribute]
inputAttributes =
          forall a. Maybe a
Prelude.Nothing,
        $sel:exportAttributeName:ExportServerEngineAttribute' :: Text
exportAttributeName = Text
pExportAttributeName_,
        $sel:serverName:ExportServerEngineAttribute' :: Text
serverName = Text
pServerName_
      }

-- | The list of engine attributes. The list type is @EngineAttribute@. An
-- @EngineAttribute@ list item is a pair that includes an attribute name
-- and its value. For the @Userdata@ ExportAttributeName, the following are
-- supported engine attribute names.
--
-- -   __RunList__ In Chef, a list of roles or recipes that are run in the
--     specified order. In Puppet, this parameter is ignored.
--
-- -   __OrganizationName__ In Chef, an organization name. AWS OpsWorks for
--     Chef Automate always creates the organization @default@. In Puppet,
--     this parameter is ignored.
--
-- -   __NodeEnvironment__ In Chef, a node environment (for example,
--     development, staging, or one-box). In Puppet, this parameter is
--     ignored.
--
-- -   __NodeClientVersion__ In Chef, the version of the Chef engine (three
--     numbers separated by dots, such as 13.8.5). If this attribute is
--     empty, OpsWorks for Chef Automate uses the most current version. In
--     Puppet, this parameter is ignored.
exportServerEngineAttribute_inputAttributes :: Lens.Lens' ExportServerEngineAttribute (Prelude.Maybe [EngineAttribute])
exportServerEngineAttribute_inputAttributes :: Lens' ExportServerEngineAttribute (Maybe [EngineAttribute])
exportServerEngineAttribute_inputAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportServerEngineAttribute' {Maybe [EngineAttribute]
inputAttributes :: Maybe [EngineAttribute]
$sel:inputAttributes:ExportServerEngineAttribute' :: ExportServerEngineAttribute -> Maybe [EngineAttribute]
inputAttributes} -> Maybe [EngineAttribute]
inputAttributes) (\s :: ExportServerEngineAttribute
s@ExportServerEngineAttribute' {} Maybe [EngineAttribute]
a -> ExportServerEngineAttribute
s {$sel:inputAttributes:ExportServerEngineAttribute' :: Maybe [EngineAttribute]
inputAttributes = Maybe [EngineAttribute]
a} :: ExportServerEngineAttribute) 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 name of the export attribute. Currently, the supported export
-- attribute is @Userdata@. This exports a user data script that includes
-- parameters and values provided in the @InputAttributes@ list.
exportServerEngineAttribute_exportAttributeName :: Lens.Lens' ExportServerEngineAttribute Prelude.Text
exportServerEngineAttribute_exportAttributeName :: Lens' ExportServerEngineAttribute Text
exportServerEngineAttribute_exportAttributeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportServerEngineAttribute' {Text
exportAttributeName :: Text
$sel:exportAttributeName:ExportServerEngineAttribute' :: ExportServerEngineAttribute -> Text
exportAttributeName} -> Text
exportAttributeName) (\s :: ExportServerEngineAttribute
s@ExportServerEngineAttribute' {} Text
a -> ExportServerEngineAttribute
s {$sel:exportAttributeName:ExportServerEngineAttribute' :: Text
exportAttributeName = Text
a} :: ExportServerEngineAttribute)

-- | The name of the server from which you are exporting the attribute.
exportServerEngineAttribute_serverName :: Lens.Lens' ExportServerEngineAttribute Prelude.Text
exportServerEngineAttribute_serverName :: Lens' ExportServerEngineAttribute Text
exportServerEngineAttribute_serverName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportServerEngineAttribute' {Text
serverName :: Text
$sel:serverName:ExportServerEngineAttribute' :: ExportServerEngineAttribute -> Text
serverName} -> Text
serverName) (\s :: ExportServerEngineAttribute
s@ExportServerEngineAttribute' {} Text
a -> ExportServerEngineAttribute
s {$sel:serverName:ExportServerEngineAttribute' :: Text
serverName = Text
a} :: ExportServerEngineAttribute)

instance Core.AWSRequest ExportServerEngineAttribute where
  type
    AWSResponse ExportServerEngineAttribute =
      ExportServerEngineAttributeResponse
  request :: (Service -> Service)
-> ExportServerEngineAttribute
-> Request ExportServerEngineAttribute
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 ExportServerEngineAttribute
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ExportServerEngineAttribute)))
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 EngineAttribute
-> Maybe Text -> Int -> ExportServerEngineAttributeResponse
ExportServerEngineAttributeResponse'
            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
"EngineAttribute")
            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
"ServerName")
            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 ExportServerEngineAttribute where
  hashWithSalt :: Int -> ExportServerEngineAttribute -> Int
hashWithSalt Int
_salt ExportServerEngineAttribute' {Maybe [EngineAttribute]
Text
serverName :: Text
exportAttributeName :: Text
inputAttributes :: Maybe [EngineAttribute]
$sel:serverName:ExportServerEngineAttribute' :: ExportServerEngineAttribute -> Text
$sel:exportAttributeName:ExportServerEngineAttribute' :: ExportServerEngineAttribute -> Text
$sel:inputAttributes:ExportServerEngineAttribute' :: ExportServerEngineAttribute -> Maybe [EngineAttribute]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [EngineAttribute]
inputAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
exportAttributeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serverName

instance Prelude.NFData ExportServerEngineAttribute where
  rnf :: ExportServerEngineAttribute -> ()
rnf ExportServerEngineAttribute' {Maybe [EngineAttribute]
Text
serverName :: Text
exportAttributeName :: Text
inputAttributes :: Maybe [EngineAttribute]
$sel:serverName:ExportServerEngineAttribute' :: ExportServerEngineAttribute -> Text
$sel:exportAttributeName:ExportServerEngineAttribute' :: ExportServerEngineAttribute -> Text
$sel:inputAttributes:ExportServerEngineAttribute' :: ExportServerEngineAttribute -> Maybe [EngineAttribute]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [EngineAttribute]
inputAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
exportAttributeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serverName

instance Data.ToHeaders ExportServerEngineAttribute where
  toHeaders :: ExportServerEngineAttribute -> 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
"OpsWorksCM_V2016_11_01.ExportServerEngineAttribute" ::
                          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 ExportServerEngineAttribute where
  toJSON :: ExportServerEngineAttribute -> Value
toJSON ExportServerEngineAttribute' {Maybe [EngineAttribute]
Text
serverName :: Text
exportAttributeName :: Text
inputAttributes :: Maybe [EngineAttribute]
$sel:serverName:ExportServerEngineAttribute' :: ExportServerEngineAttribute -> Text
$sel:exportAttributeName:ExportServerEngineAttribute' :: ExportServerEngineAttribute -> Text
$sel:inputAttributes:ExportServerEngineAttribute' :: ExportServerEngineAttribute -> Maybe [EngineAttribute]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"InputAttributes" 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 [EngineAttribute]
inputAttributes,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ExportAttributeName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
exportAttributeName),
            forall a. a -> Maybe a
Prelude.Just (Key
"ServerName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serverName)
          ]
      )

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

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

-- | /See:/ 'newExportServerEngineAttributeResponse' smart constructor.
data ExportServerEngineAttributeResponse = ExportServerEngineAttributeResponse'
  { -- | The requested engine attribute pair with attribute name and value.
    ExportServerEngineAttributeResponse -> Maybe EngineAttribute
engineAttribute :: Prelude.Maybe EngineAttribute,
    -- | The server name used in the request.
    ExportServerEngineAttributeResponse -> Maybe Text
serverName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ExportServerEngineAttributeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ExportServerEngineAttributeResponse
-> ExportServerEngineAttributeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportServerEngineAttributeResponse
-> ExportServerEngineAttributeResponse -> Bool
$c/= :: ExportServerEngineAttributeResponse
-> ExportServerEngineAttributeResponse -> Bool
== :: ExportServerEngineAttributeResponse
-> ExportServerEngineAttributeResponse -> Bool
$c== :: ExportServerEngineAttributeResponse
-> ExportServerEngineAttributeResponse -> Bool
Prelude.Eq, Int -> ExportServerEngineAttributeResponse -> ShowS
[ExportServerEngineAttributeResponse] -> ShowS
ExportServerEngineAttributeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportServerEngineAttributeResponse] -> ShowS
$cshowList :: [ExportServerEngineAttributeResponse] -> ShowS
show :: ExportServerEngineAttributeResponse -> String
$cshow :: ExportServerEngineAttributeResponse -> String
showsPrec :: Int -> ExportServerEngineAttributeResponse -> ShowS
$cshowsPrec :: Int -> ExportServerEngineAttributeResponse -> ShowS
Prelude.Show, forall x.
Rep ExportServerEngineAttributeResponse x
-> ExportServerEngineAttributeResponse
forall x.
ExportServerEngineAttributeResponse
-> Rep ExportServerEngineAttributeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ExportServerEngineAttributeResponse x
-> ExportServerEngineAttributeResponse
$cfrom :: forall x.
ExportServerEngineAttributeResponse
-> Rep ExportServerEngineAttributeResponse x
Prelude.Generic)

-- |
-- Create a value of 'ExportServerEngineAttributeResponse' 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:
--
-- 'engineAttribute', 'exportServerEngineAttributeResponse_engineAttribute' - The requested engine attribute pair with attribute name and value.
--
-- 'serverName', 'exportServerEngineAttributeResponse_serverName' - The server name used in the request.
--
-- 'httpStatus', 'exportServerEngineAttributeResponse_httpStatus' - The response's http status code.
newExportServerEngineAttributeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ExportServerEngineAttributeResponse
newExportServerEngineAttributeResponse :: Int -> ExportServerEngineAttributeResponse
newExportServerEngineAttributeResponse Int
pHttpStatus_ =
  ExportServerEngineAttributeResponse'
    { $sel:engineAttribute:ExportServerEngineAttributeResponse' :: Maybe EngineAttribute
engineAttribute =
        forall a. Maybe a
Prelude.Nothing,
      $sel:serverName:ExportServerEngineAttributeResponse' :: Maybe Text
serverName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ExportServerEngineAttributeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The requested engine attribute pair with attribute name and value.
exportServerEngineAttributeResponse_engineAttribute :: Lens.Lens' ExportServerEngineAttributeResponse (Prelude.Maybe EngineAttribute)
exportServerEngineAttributeResponse_engineAttribute :: Lens' ExportServerEngineAttributeResponse (Maybe EngineAttribute)
exportServerEngineAttributeResponse_engineAttribute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportServerEngineAttributeResponse' {Maybe EngineAttribute
engineAttribute :: Maybe EngineAttribute
$sel:engineAttribute:ExportServerEngineAttributeResponse' :: ExportServerEngineAttributeResponse -> Maybe EngineAttribute
engineAttribute} -> Maybe EngineAttribute
engineAttribute) (\s :: ExportServerEngineAttributeResponse
s@ExportServerEngineAttributeResponse' {} Maybe EngineAttribute
a -> ExportServerEngineAttributeResponse
s {$sel:engineAttribute:ExportServerEngineAttributeResponse' :: Maybe EngineAttribute
engineAttribute = Maybe EngineAttribute
a} :: ExportServerEngineAttributeResponse)

-- | The server name used in the request.
exportServerEngineAttributeResponse_serverName :: Lens.Lens' ExportServerEngineAttributeResponse (Prelude.Maybe Prelude.Text)
exportServerEngineAttributeResponse_serverName :: Lens' ExportServerEngineAttributeResponse (Maybe Text)
exportServerEngineAttributeResponse_serverName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportServerEngineAttributeResponse' {Maybe Text
serverName :: Maybe Text
$sel:serverName:ExportServerEngineAttributeResponse' :: ExportServerEngineAttributeResponse -> Maybe Text
serverName} -> Maybe Text
serverName) (\s :: ExportServerEngineAttributeResponse
s@ExportServerEngineAttributeResponse' {} Maybe Text
a -> ExportServerEngineAttributeResponse
s {$sel:serverName:ExportServerEngineAttributeResponse' :: Maybe Text
serverName = Maybe Text
a} :: ExportServerEngineAttributeResponse)

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

instance
  Prelude.NFData
    ExportServerEngineAttributeResponse
  where
  rnf :: ExportServerEngineAttributeResponse -> ()
rnf ExportServerEngineAttributeResponse' {Int
Maybe Text
Maybe EngineAttribute
httpStatus :: Int
serverName :: Maybe Text
engineAttribute :: Maybe EngineAttribute
$sel:httpStatus:ExportServerEngineAttributeResponse' :: ExportServerEngineAttributeResponse -> Int
$sel:serverName:ExportServerEngineAttributeResponse' :: ExportServerEngineAttributeResponse -> Maybe Text
$sel:engineAttribute:ExportServerEngineAttributeResponse' :: ExportServerEngineAttributeResponse -> Maybe EngineAttribute
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe EngineAttribute
engineAttribute
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serverName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus