{-# 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.DisassociateNode
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disassociates a node from an AWS OpsWorks CM server, and removes the
-- node from the server\'s managed nodes. After a node is disassociated,
-- the node key pair is no longer valid for accessing the configuration
-- manager\'s API. For more information about how to associate a node, see
-- AssociateNode.
--
-- A node can can only be disassociated from a server that is in a
-- @HEALTHY@ state. Otherwise, an @InvalidStateException@ is thrown. A
-- @ResourceNotFoundException@ is thrown when the server does not exist. A
-- @ValidationException@ is raised when parameters of the request are not
-- valid.
module Amazonka.OpsWorksCM.DisassociateNode
  ( -- * Creating a Request
    DisassociateNode (..),
    newDisassociateNode,

    -- * Request Lenses
    disassociateNode_engineAttributes,
    disassociateNode_serverName,
    disassociateNode_nodeName,

    -- * Destructuring the Response
    DisassociateNodeResponse (..),
    newDisassociateNodeResponse,

    -- * Response Lenses
    disassociateNodeResponse_nodeAssociationStatusToken,
    disassociateNodeResponse_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:/ 'newDisassociateNode' smart constructor.
data DisassociateNode = DisassociateNode'
  { -- | Engine attributes that are used for disassociating the node. No
    -- attributes are required for Puppet.
    --
    -- __Attributes required in a DisassociateNode request for Chef__
    --
    -- -   @CHEF_ORGANIZATION@: The Chef organization with which the node was
    --     associated. By default only one organization named @default@ can
    --     exist.
    DisassociateNode -> Maybe [EngineAttribute]
engineAttributes :: Prelude.Maybe [EngineAttribute],
    -- | The name of the server from which to disassociate the node.
    DisassociateNode -> Text
serverName :: Prelude.Text,
    -- | The name of the client node.
    DisassociateNode -> Text
nodeName :: Prelude.Text
  }
  deriving (DisassociateNode -> DisassociateNode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateNode -> DisassociateNode -> Bool
$c/= :: DisassociateNode -> DisassociateNode -> Bool
== :: DisassociateNode -> DisassociateNode -> Bool
$c== :: DisassociateNode -> DisassociateNode -> Bool
Prelude.Eq, Int -> DisassociateNode -> ShowS
[DisassociateNode] -> ShowS
DisassociateNode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateNode] -> ShowS
$cshowList :: [DisassociateNode] -> ShowS
show :: DisassociateNode -> String
$cshow :: DisassociateNode -> String
showsPrec :: Int -> DisassociateNode -> ShowS
$cshowsPrec :: Int -> DisassociateNode -> ShowS
Prelude.Show, forall x. Rep DisassociateNode x -> DisassociateNode
forall x. DisassociateNode -> Rep DisassociateNode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisassociateNode x -> DisassociateNode
$cfrom :: forall x. DisassociateNode -> Rep DisassociateNode x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateNode' 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', 'disassociateNode_engineAttributes' - Engine attributes that are used for disassociating the node. No
-- attributes are required for Puppet.
--
-- __Attributes required in a DisassociateNode request for Chef__
--
-- -   @CHEF_ORGANIZATION@: The Chef organization with which the node was
--     associated. By default only one organization named @default@ can
--     exist.
--
-- 'serverName', 'disassociateNode_serverName' - The name of the server from which to disassociate the node.
--
-- 'nodeName', 'disassociateNode_nodeName' - The name of the client node.
newDisassociateNode ::
  -- | 'serverName'
  Prelude.Text ->
  -- | 'nodeName'
  Prelude.Text ->
  DisassociateNode
newDisassociateNode :: Text -> Text -> DisassociateNode
newDisassociateNode Text
pServerName_ Text
pNodeName_ =
  DisassociateNode'
    { $sel:engineAttributes:DisassociateNode' :: Maybe [EngineAttribute]
engineAttributes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:serverName:DisassociateNode' :: Text
serverName = Text
pServerName_,
      $sel:nodeName:DisassociateNode' :: Text
nodeName = Text
pNodeName_
    }

-- | Engine attributes that are used for disassociating the node. No
-- attributes are required for Puppet.
--
-- __Attributes required in a DisassociateNode request for Chef__
--
-- -   @CHEF_ORGANIZATION@: The Chef organization with which the node was
--     associated. By default only one organization named @default@ can
--     exist.
disassociateNode_engineAttributes :: Lens.Lens' DisassociateNode (Prelude.Maybe [EngineAttribute])
disassociateNode_engineAttributes :: Lens' DisassociateNode (Maybe [EngineAttribute])
disassociateNode_engineAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateNode' {Maybe [EngineAttribute]
engineAttributes :: Maybe [EngineAttribute]
$sel:engineAttributes:DisassociateNode' :: DisassociateNode -> Maybe [EngineAttribute]
engineAttributes} -> Maybe [EngineAttribute]
engineAttributes) (\s :: DisassociateNode
s@DisassociateNode' {} Maybe [EngineAttribute]
a -> DisassociateNode
s {$sel:engineAttributes:DisassociateNode' :: Maybe [EngineAttribute]
engineAttributes = Maybe [EngineAttribute]
a} :: DisassociateNode) 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 server from which to disassociate the node.
disassociateNode_serverName :: Lens.Lens' DisassociateNode Prelude.Text
disassociateNode_serverName :: Lens' DisassociateNode Text
disassociateNode_serverName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateNode' {Text
serverName :: Text
$sel:serverName:DisassociateNode' :: DisassociateNode -> Text
serverName} -> Text
serverName) (\s :: DisassociateNode
s@DisassociateNode' {} Text
a -> DisassociateNode
s {$sel:serverName:DisassociateNode' :: Text
serverName = Text
a} :: DisassociateNode)

-- | The name of the client node.
disassociateNode_nodeName :: Lens.Lens' DisassociateNode Prelude.Text
disassociateNode_nodeName :: Lens' DisassociateNode Text
disassociateNode_nodeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateNode' {Text
nodeName :: Text
$sel:nodeName:DisassociateNode' :: DisassociateNode -> Text
nodeName} -> Text
nodeName) (\s :: DisassociateNode
s@DisassociateNode' {} Text
a -> DisassociateNode
s {$sel:nodeName:DisassociateNode' :: Text
nodeName = Text
a} :: DisassociateNode)

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

instance Prelude.NFData DisassociateNode where
  rnf :: DisassociateNode -> ()
rnf DisassociateNode' {Maybe [EngineAttribute]
Text
nodeName :: Text
serverName :: Text
engineAttributes :: Maybe [EngineAttribute]
$sel:nodeName:DisassociateNode' :: DisassociateNode -> Text
$sel:serverName:DisassociateNode' :: DisassociateNode -> Text
$sel:engineAttributes:DisassociateNode' :: DisassociateNode -> 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 Text
serverName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
nodeName

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

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

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

-- | /See:/ 'newDisassociateNodeResponse' smart constructor.
data DisassociateNodeResponse = DisassociateNodeResponse'
  { -- | Contains a token which can be passed to the
    -- @DescribeNodeAssociationStatus@ API call to get the status of the
    -- disassociation request.
    DisassociateNodeResponse -> Maybe Text
nodeAssociationStatusToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DisassociateNodeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DisassociateNodeResponse -> DisassociateNodeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateNodeResponse -> DisassociateNodeResponse -> Bool
$c/= :: DisassociateNodeResponse -> DisassociateNodeResponse -> Bool
== :: DisassociateNodeResponse -> DisassociateNodeResponse -> Bool
$c== :: DisassociateNodeResponse -> DisassociateNodeResponse -> Bool
Prelude.Eq, ReadPrec [DisassociateNodeResponse]
ReadPrec DisassociateNodeResponse
Int -> ReadS DisassociateNodeResponse
ReadS [DisassociateNodeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateNodeResponse]
$creadListPrec :: ReadPrec [DisassociateNodeResponse]
readPrec :: ReadPrec DisassociateNodeResponse
$creadPrec :: ReadPrec DisassociateNodeResponse
readList :: ReadS [DisassociateNodeResponse]
$creadList :: ReadS [DisassociateNodeResponse]
readsPrec :: Int -> ReadS DisassociateNodeResponse
$creadsPrec :: Int -> ReadS DisassociateNodeResponse
Prelude.Read, Int -> DisassociateNodeResponse -> ShowS
[DisassociateNodeResponse] -> ShowS
DisassociateNodeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateNodeResponse] -> ShowS
$cshowList :: [DisassociateNodeResponse] -> ShowS
show :: DisassociateNodeResponse -> String
$cshow :: DisassociateNodeResponse -> String
showsPrec :: Int -> DisassociateNodeResponse -> ShowS
$cshowsPrec :: Int -> DisassociateNodeResponse -> ShowS
Prelude.Show, forall x.
Rep DisassociateNodeResponse x -> DisassociateNodeResponse
forall x.
DisassociateNodeResponse -> Rep DisassociateNodeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateNodeResponse x -> DisassociateNodeResponse
$cfrom :: forall x.
DisassociateNodeResponse -> Rep DisassociateNodeResponse x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateNodeResponse' 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', 'disassociateNodeResponse_nodeAssociationStatusToken' - Contains a token which can be passed to the
-- @DescribeNodeAssociationStatus@ API call to get the status of the
-- disassociation request.
--
-- 'httpStatus', 'disassociateNodeResponse_httpStatus' - The response's http status code.
newDisassociateNodeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DisassociateNodeResponse
newDisassociateNodeResponse :: Int -> DisassociateNodeResponse
newDisassociateNodeResponse Int
pHttpStatus_ =
  DisassociateNodeResponse'
    { $sel:nodeAssociationStatusToken:DisassociateNodeResponse' :: Maybe Text
nodeAssociationStatusToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DisassociateNodeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Contains a token which can be passed to the
-- @DescribeNodeAssociationStatus@ API call to get the status of the
-- disassociation request.
disassociateNodeResponse_nodeAssociationStatusToken :: Lens.Lens' DisassociateNodeResponse (Prelude.Maybe Prelude.Text)
disassociateNodeResponse_nodeAssociationStatusToken :: Lens' DisassociateNodeResponse (Maybe Text)
disassociateNodeResponse_nodeAssociationStatusToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateNodeResponse' {Maybe Text
nodeAssociationStatusToken :: Maybe Text
$sel:nodeAssociationStatusToken:DisassociateNodeResponse' :: DisassociateNodeResponse -> Maybe Text
nodeAssociationStatusToken} -> Maybe Text
nodeAssociationStatusToken) (\s :: DisassociateNodeResponse
s@DisassociateNodeResponse' {} Maybe Text
a -> DisassociateNodeResponse
s {$sel:nodeAssociationStatusToken:DisassociateNodeResponse' :: Maybe Text
nodeAssociationStatusToken = Maybe Text
a} :: DisassociateNodeResponse)

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

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