{-# 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.DescribeNodeAssociationStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the current status of an existing association or disassociation
-- request.
--
-- A @ResourceNotFoundException@ is thrown when no recent association or
-- disassociation request with the specified token is found, or when the
-- server does not exist. A @ValidationException@ is raised when parameters
-- of the request are not valid.
module Amazonka.OpsWorksCM.DescribeNodeAssociationStatus
  ( -- * Creating a Request
    DescribeNodeAssociationStatus (..),
    newDescribeNodeAssociationStatus,

    -- * Request Lenses
    describeNodeAssociationStatus_nodeAssociationStatusToken,
    describeNodeAssociationStatus_serverName,

    -- * Destructuring the Response
    DescribeNodeAssociationStatusResponse (..),
    newDescribeNodeAssociationStatusResponse,

    -- * Response Lenses
    describeNodeAssociationStatusResponse_engineAttributes,
    describeNodeAssociationStatusResponse_httpStatus,
    describeNodeAssociationStatusResponse_nodeAssociationStatus,
  )
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:/ 'newDescribeNodeAssociationStatus' smart constructor.
data DescribeNodeAssociationStatus = DescribeNodeAssociationStatus'
  { -- | The token returned in either the AssociateNodeResponse or the
    -- DisassociateNodeResponse.
    DescribeNodeAssociationStatus -> Text
nodeAssociationStatusToken :: Prelude.Text,
    -- | The name of the server from which to disassociate the node.
    DescribeNodeAssociationStatus -> Text
serverName :: Prelude.Text
  }
  deriving (DescribeNodeAssociationStatus
-> DescribeNodeAssociationStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeNodeAssociationStatus
-> DescribeNodeAssociationStatus -> Bool
$c/= :: DescribeNodeAssociationStatus
-> DescribeNodeAssociationStatus -> Bool
== :: DescribeNodeAssociationStatus
-> DescribeNodeAssociationStatus -> Bool
$c== :: DescribeNodeAssociationStatus
-> DescribeNodeAssociationStatus -> Bool
Prelude.Eq, ReadPrec [DescribeNodeAssociationStatus]
ReadPrec DescribeNodeAssociationStatus
Int -> ReadS DescribeNodeAssociationStatus
ReadS [DescribeNodeAssociationStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeNodeAssociationStatus]
$creadListPrec :: ReadPrec [DescribeNodeAssociationStatus]
readPrec :: ReadPrec DescribeNodeAssociationStatus
$creadPrec :: ReadPrec DescribeNodeAssociationStatus
readList :: ReadS [DescribeNodeAssociationStatus]
$creadList :: ReadS [DescribeNodeAssociationStatus]
readsPrec :: Int -> ReadS DescribeNodeAssociationStatus
$creadsPrec :: Int -> ReadS DescribeNodeAssociationStatus
Prelude.Read, Int -> DescribeNodeAssociationStatus -> ShowS
[DescribeNodeAssociationStatus] -> ShowS
DescribeNodeAssociationStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeNodeAssociationStatus] -> ShowS
$cshowList :: [DescribeNodeAssociationStatus] -> ShowS
show :: DescribeNodeAssociationStatus -> String
$cshow :: DescribeNodeAssociationStatus -> String
showsPrec :: Int -> DescribeNodeAssociationStatus -> ShowS
$cshowsPrec :: Int -> DescribeNodeAssociationStatus -> ShowS
Prelude.Show, forall x.
Rep DescribeNodeAssociationStatus x
-> DescribeNodeAssociationStatus
forall x.
DescribeNodeAssociationStatus
-> Rep DescribeNodeAssociationStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeNodeAssociationStatus x
-> DescribeNodeAssociationStatus
$cfrom :: forall x.
DescribeNodeAssociationStatus
-> Rep DescribeNodeAssociationStatus x
Prelude.Generic)

-- |
-- Create a value of 'DescribeNodeAssociationStatus' 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:
--
-- 'nodeAssociationStatusToken', 'describeNodeAssociationStatus_nodeAssociationStatusToken' - The token returned in either the AssociateNodeResponse or the
-- DisassociateNodeResponse.
--
-- 'serverName', 'describeNodeAssociationStatus_serverName' - The name of the server from which to disassociate the node.
newDescribeNodeAssociationStatus ::
  -- | 'nodeAssociationStatusToken'
  Prelude.Text ->
  -- | 'serverName'
  Prelude.Text ->
  DescribeNodeAssociationStatus
newDescribeNodeAssociationStatus :: Text -> Text -> DescribeNodeAssociationStatus
newDescribeNodeAssociationStatus
  Text
pNodeAssociationStatusToken_
  Text
pServerName_ =
    DescribeNodeAssociationStatus'
      { $sel:nodeAssociationStatusToken:DescribeNodeAssociationStatus' :: Text
nodeAssociationStatusToken =
          Text
pNodeAssociationStatusToken_,
        $sel:serverName:DescribeNodeAssociationStatus' :: Text
serverName = Text
pServerName_
      }

-- | The token returned in either the AssociateNodeResponse or the
-- DisassociateNodeResponse.
describeNodeAssociationStatus_nodeAssociationStatusToken :: Lens.Lens' DescribeNodeAssociationStatus Prelude.Text
describeNodeAssociationStatus_nodeAssociationStatusToken :: Lens' DescribeNodeAssociationStatus Text
describeNodeAssociationStatus_nodeAssociationStatusToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeAssociationStatus' {Text
nodeAssociationStatusToken :: Text
$sel:nodeAssociationStatusToken:DescribeNodeAssociationStatus' :: DescribeNodeAssociationStatus -> Text
nodeAssociationStatusToken} -> Text
nodeAssociationStatusToken) (\s :: DescribeNodeAssociationStatus
s@DescribeNodeAssociationStatus' {} Text
a -> DescribeNodeAssociationStatus
s {$sel:nodeAssociationStatusToken:DescribeNodeAssociationStatus' :: Text
nodeAssociationStatusToken = Text
a} :: DescribeNodeAssociationStatus)

-- | The name of the server from which to disassociate the node.
describeNodeAssociationStatus_serverName :: Lens.Lens' DescribeNodeAssociationStatus Prelude.Text
describeNodeAssociationStatus_serverName :: Lens' DescribeNodeAssociationStatus Text
describeNodeAssociationStatus_serverName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeAssociationStatus' {Text
serverName :: Text
$sel:serverName:DescribeNodeAssociationStatus' :: DescribeNodeAssociationStatus -> Text
serverName} -> Text
serverName) (\s :: DescribeNodeAssociationStatus
s@DescribeNodeAssociationStatus' {} Text
a -> DescribeNodeAssociationStatus
s {$sel:serverName:DescribeNodeAssociationStatus' :: Text
serverName = Text
a} :: DescribeNodeAssociationStatus)

instance
  Core.AWSRequest
    DescribeNodeAssociationStatus
  where
  type
    AWSResponse DescribeNodeAssociationStatus =
      DescribeNodeAssociationStatusResponse
  request :: (Service -> Service)
-> DescribeNodeAssociationStatus
-> Request DescribeNodeAssociationStatus
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 DescribeNodeAssociationStatus
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeNodeAssociationStatus)))
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]
-> Int
-> NodeAssociationStatus
-> DescribeNodeAssociationStatusResponse
DescribeNodeAssociationStatusResponse'
            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
"EngineAttributes"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"NodeAssociationStatus")
      )

instance
  Prelude.Hashable
    DescribeNodeAssociationStatus
  where
  hashWithSalt :: Int -> DescribeNodeAssociationStatus -> Int
hashWithSalt Int
_salt DescribeNodeAssociationStatus' {Text
serverName :: Text
nodeAssociationStatusToken :: Text
$sel:serverName:DescribeNodeAssociationStatus' :: DescribeNodeAssociationStatus -> Text
$sel:nodeAssociationStatusToken:DescribeNodeAssociationStatus' :: DescribeNodeAssociationStatus -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
nodeAssociationStatusToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serverName

instance Prelude.NFData DescribeNodeAssociationStatus where
  rnf :: DescribeNodeAssociationStatus -> ()
rnf DescribeNodeAssociationStatus' {Text
serverName :: Text
nodeAssociationStatusToken :: Text
$sel:serverName:DescribeNodeAssociationStatus' :: DescribeNodeAssociationStatus -> Text
$sel:nodeAssociationStatusToken:DescribeNodeAssociationStatus' :: DescribeNodeAssociationStatus -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
nodeAssociationStatusToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serverName

instance Data.ToHeaders DescribeNodeAssociationStatus where
  toHeaders :: DescribeNodeAssociationStatus -> 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.DescribeNodeAssociationStatus" ::
                          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 DescribeNodeAssociationStatus where
  toJSON :: DescribeNodeAssociationStatus -> Value
toJSON DescribeNodeAssociationStatus' {Text
serverName :: Text
nodeAssociationStatusToken :: Text
$sel:serverName:DescribeNodeAssociationStatus' :: DescribeNodeAssociationStatus -> Text
$sel:nodeAssociationStatusToken:DescribeNodeAssociationStatus' :: DescribeNodeAssociationStatus -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"NodeAssociationStatusToken"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
nodeAssociationStatusToken
              ),
            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 DescribeNodeAssociationStatus where
  toPath :: DescribeNodeAssociationStatus -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDescribeNodeAssociationStatusResponse' smart constructor.
data DescribeNodeAssociationStatusResponse = DescribeNodeAssociationStatusResponse'
  { -- | Attributes specific to the node association. In Puppet, the attibute
    -- PUPPET_NODE_CERT contains the signed certificate (the result of the
    -- CSR).
    DescribeNodeAssociationStatusResponse -> Maybe [EngineAttribute]
engineAttributes :: Prelude.Maybe [EngineAttribute],
    -- | The response's http status code.
    DescribeNodeAssociationStatusResponse -> Int
httpStatus :: Prelude.Int,
    -- | The status of the association or disassociation request.
    --
    -- __Possible values:__
    --
    -- -   @SUCCESS@: The association or disassociation succeeded.
    --
    -- -   @FAILED@: The association or disassociation failed.
    --
    -- -   @IN_PROGRESS@: The association or disassociation is still in
    --     progress.
    DescribeNodeAssociationStatusResponse -> NodeAssociationStatus
nodeAssociationStatus :: NodeAssociationStatus
  }
  deriving (DescribeNodeAssociationStatusResponse
-> DescribeNodeAssociationStatusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeNodeAssociationStatusResponse
-> DescribeNodeAssociationStatusResponse -> Bool
$c/= :: DescribeNodeAssociationStatusResponse
-> DescribeNodeAssociationStatusResponse -> Bool
== :: DescribeNodeAssociationStatusResponse
-> DescribeNodeAssociationStatusResponse -> Bool
$c== :: DescribeNodeAssociationStatusResponse
-> DescribeNodeAssociationStatusResponse -> Bool
Prelude.Eq, Int -> DescribeNodeAssociationStatusResponse -> ShowS
[DescribeNodeAssociationStatusResponse] -> ShowS
DescribeNodeAssociationStatusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeNodeAssociationStatusResponse] -> ShowS
$cshowList :: [DescribeNodeAssociationStatusResponse] -> ShowS
show :: DescribeNodeAssociationStatusResponse -> String
$cshow :: DescribeNodeAssociationStatusResponse -> String
showsPrec :: Int -> DescribeNodeAssociationStatusResponse -> ShowS
$cshowsPrec :: Int -> DescribeNodeAssociationStatusResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeNodeAssociationStatusResponse x
-> DescribeNodeAssociationStatusResponse
forall x.
DescribeNodeAssociationStatusResponse
-> Rep DescribeNodeAssociationStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeNodeAssociationStatusResponse x
-> DescribeNodeAssociationStatusResponse
$cfrom :: forall x.
DescribeNodeAssociationStatusResponse
-> Rep DescribeNodeAssociationStatusResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeNodeAssociationStatusResponse' 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:
--
-- 'engineAttributes', 'describeNodeAssociationStatusResponse_engineAttributes' - Attributes specific to the node association. In Puppet, the attibute
-- PUPPET_NODE_CERT contains the signed certificate (the result of the
-- CSR).
--
-- 'httpStatus', 'describeNodeAssociationStatusResponse_httpStatus' - The response's http status code.
--
-- 'nodeAssociationStatus', 'describeNodeAssociationStatusResponse_nodeAssociationStatus' - The status of the association or disassociation request.
--
-- __Possible values:__
--
-- -   @SUCCESS@: The association or disassociation succeeded.
--
-- -   @FAILED@: The association or disassociation failed.
--
-- -   @IN_PROGRESS@: The association or disassociation is still in
--     progress.
newDescribeNodeAssociationStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'nodeAssociationStatus'
  NodeAssociationStatus ->
  DescribeNodeAssociationStatusResponse
newDescribeNodeAssociationStatusResponse :: Int
-> NodeAssociationStatus -> DescribeNodeAssociationStatusResponse
newDescribeNodeAssociationStatusResponse
  Int
pHttpStatus_
  NodeAssociationStatus
pNodeAssociationStatus_ =
    DescribeNodeAssociationStatusResponse'
      { $sel:engineAttributes:DescribeNodeAssociationStatusResponse' :: Maybe [EngineAttribute]
engineAttributes =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeNodeAssociationStatusResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:nodeAssociationStatus:DescribeNodeAssociationStatusResponse' :: NodeAssociationStatus
nodeAssociationStatus =
          NodeAssociationStatus
pNodeAssociationStatus_
      }

-- | Attributes specific to the node association. In Puppet, the attibute
-- PUPPET_NODE_CERT contains the signed certificate (the result of the
-- CSR).
describeNodeAssociationStatusResponse_engineAttributes :: Lens.Lens' DescribeNodeAssociationStatusResponse (Prelude.Maybe [EngineAttribute])
describeNodeAssociationStatusResponse_engineAttributes :: Lens'
  DescribeNodeAssociationStatusResponse (Maybe [EngineAttribute])
describeNodeAssociationStatusResponse_engineAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeAssociationStatusResponse' {Maybe [EngineAttribute]
engineAttributes :: Maybe [EngineAttribute]
$sel:engineAttributes:DescribeNodeAssociationStatusResponse' :: DescribeNodeAssociationStatusResponse -> Maybe [EngineAttribute]
engineAttributes} -> Maybe [EngineAttribute]
engineAttributes) (\s :: DescribeNodeAssociationStatusResponse
s@DescribeNodeAssociationStatusResponse' {} Maybe [EngineAttribute]
a -> DescribeNodeAssociationStatusResponse
s {$sel:engineAttributes:DescribeNodeAssociationStatusResponse' :: Maybe [EngineAttribute]
engineAttributes = Maybe [EngineAttribute]
a} :: DescribeNodeAssociationStatusResponse) 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.
describeNodeAssociationStatusResponse_httpStatus :: Lens.Lens' DescribeNodeAssociationStatusResponse Prelude.Int
describeNodeAssociationStatusResponse_httpStatus :: Lens' DescribeNodeAssociationStatusResponse Int
describeNodeAssociationStatusResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeAssociationStatusResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeNodeAssociationStatusResponse' :: DescribeNodeAssociationStatusResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeNodeAssociationStatusResponse
s@DescribeNodeAssociationStatusResponse' {} Int
a -> DescribeNodeAssociationStatusResponse
s {$sel:httpStatus:DescribeNodeAssociationStatusResponse' :: Int
httpStatus = Int
a} :: DescribeNodeAssociationStatusResponse)

-- | The status of the association or disassociation request.
--
-- __Possible values:__
--
-- -   @SUCCESS@: The association or disassociation succeeded.
--
-- -   @FAILED@: The association or disassociation failed.
--
-- -   @IN_PROGRESS@: The association or disassociation is still in
--     progress.
describeNodeAssociationStatusResponse_nodeAssociationStatus :: Lens.Lens' DescribeNodeAssociationStatusResponse NodeAssociationStatus
describeNodeAssociationStatusResponse_nodeAssociationStatus :: Lens' DescribeNodeAssociationStatusResponse NodeAssociationStatus
describeNodeAssociationStatusResponse_nodeAssociationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNodeAssociationStatusResponse' {NodeAssociationStatus
nodeAssociationStatus :: NodeAssociationStatus
$sel:nodeAssociationStatus:DescribeNodeAssociationStatusResponse' :: DescribeNodeAssociationStatusResponse -> NodeAssociationStatus
nodeAssociationStatus} -> NodeAssociationStatus
nodeAssociationStatus) (\s :: DescribeNodeAssociationStatusResponse
s@DescribeNodeAssociationStatusResponse' {} NodeAssociationStatus
a -> DescribeNodeAssociationStatusResponse
s {$sel:nodeAssociationStatus:DescribeNodeAssociationStatusResponse' :: NodeAssociationStatus
nodeAssociationStatus = NodeAssociationStatus
a} :: DescribeNodeAssociationStatusResponse)

instance
  Prelude.NFData
    DescribeNodeAssociationStatusResponse
  where
  rnf :: DescribeNodeAssociationStatusResponse -> ()
rnf DescribeNodeAssociationStatusResponse' {Int
Maybe [EngineAttribute]
NodeAssociationStatus
nodeAssociationStatus :: NodeAssociationStatus
httpStatus :: Int
engineAttributes :: Maybe [EngineAttribute]
$sel:nodeAssociationStatus:DescribeNodeAssociationStatusResponse' :: DescribeNodeAssociationStatusResponse -> NodeAssociationStatus
$sel:httpStatus:DescribeNodeAssociationStatusResponse' :: DescribeNodeAssociationStatusResponse -> Int
$sel:engineAttributes:DescribeNodeAssociationStatusResponse' :: DescribeNodeAssociationStatusResponse -> Maybe [EngineAttribute]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [EngineAttribute]
engineAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NodeAssociationStatus
nodeAssociationStatus