{-# 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.DAX.RebootNode
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Reboots a single node of a DAX cluster. The reboot action takes place as
-- soon as possible. During the reboot, the node status is set to
-- REBOOTING.
--
-- @RebootNode@ restarts the DAX engine process and does not remove the
-- contents of the cache.
module Amazonka.DAX.RebootNode
  ( -- * Creating a Request
    RebootNode (..),
    newRebootNode,

    -- * Request Lenses
    rebootNode_clusterName,
    rebootNode_nodeId,

    -- * Destructuring the Response
    RebootNodeResponse (..),
    newRebootNodeResponse,

    -- * Response Lenses
    rebootNodeResponse_cluster,
    rebootNodeResponse_httpStatus,
  )
where

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

-- | /See:/ 'newRebootNode' smart constructor.
data RebootNode = RebootNode'
  { -- | The name of the DAX cluster containing the node to be rebooted.
    RebootNode -> Text
clusterName :: Prelude.Text,
    -- | The system-assigned ID of the node to be rebooted.
    RebootNode -> Text
nodeId :: Prelude.Text
  }
  deriving (RebootNode -> RebootNode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RebootNode -> RebootNode -> Bool
$c/= :: RebootNode -> RebootNode -> Bool
== :: RebootNode -> RebootNode -> Bool
$c== :: RebootNode -> RebootNode -> Bool
Prelude.Eq, ReadPrec [RebootNode]
ReadPrec RebootNode
Int -> ReadS RebootNode
ReadS [RebootNode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RebootNode]
$creadListPrec :: ReadPrec [RebootNode]
readPrec :: ReadPrec RebootNode
$creadPrec :: ReadPrec RebootNode
readList :: ReadS [RebootNode]
$creadList :: ReadS [RebootNode]
readsPrec :: Int -> ReadS RebootNode
$creadsPrec :: Int -> ReadS RebootNode
Prelude.Read, Int -> RebootNode -> ShowS
[RebootNode] -> ShowS
RebootNode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RebootNode] -> ShowS
$cshowList :: [RebootNode] -> ShowS
show :: RebootNode -> String
$cshow :: RebootNode -> String
showsPrec :: Int -> RebootNode -> ShowS
$cshowsPrec :: Int -> RebootNode -> ShowS
Prelude.Show, forall x. Rep RebootNode x -> RebootNode
forall x. RebootNode -> Rep RebootNode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RebootNode x -> RebootNode
$cfrom :: forall x. RebootNode -> Rep RebootNode x
Prelude.Generic)

-- |
-- Create a value of 'RebootNode' 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:
--
-- 'clusterName', 'rebootNode_clusterName' - The name of the DAX cluster containing the node to be rebooted.
--
-- 'nodeId', 'rebootNode_nodeId' - The system-assigned ID of the node to be rebooted.
newRebootNode ::
  -- | 'clusterName'
  Prelude.Text ->
  -- | 'nodeId'
  Prelude.Text ->
  RebootNode
newRebootNode :: Text -> Text -> RebootNode
newRebootNode Text
pClusterName_ Text
pNodeId_ =
  RebootNode'
    { $sel:clusterName:RebootNode' :: Text
clusterName = Text
pClusterName_,
      $sel:nodeId:RebootNode' :: Text
nodeId = Text
pNodeId_
    }

-- | The name of the DAX cluster containing the node to be rebooted.
rebootNode_clusterName :: Lens.Lens' RebootNode Prelude.Text
rebootNode_clusterName :: Lens' RebootNode Text
rebootNode_clusterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RebootNode' {Text
clusterName :: Text
$sel:clusterName:RebootNode' :: RebootNode -> Text
clusterName} -> Text
clusterName) (\s :: RebootNode
s@RebootNode' {} Text
a -> RebootNode
s {$sel:clusterName:RebootNode' :: Text
clusterName = Text
a} :: RebootNode)

-- | The system-assigned ID of the node to be rebooted.
rebootNode_nodeId :: Lens.Lens' RebootNode Prelude.Text
rebootNode_nodeId :: Lens' RebootNode Text
rebootNode_nodeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RebootNode' {Text
nodeId :: Text
$sel:nodeId:RebootNode' :: RebootNode -> Text
nodeId} -> Text
nodeId) (\s :: RebootNode
s@RebootNode' {} Text
a -> RebootNode
s {$sel:nodeId:RebootNode' :: Text
nodeId = Text
a} :: RebootNode)

instance Core.AWSRequest RebootNode where
  type AWSResponse RebootNode = RebootNodeResponse
  request :: (Service -> Service) -> RebootNode -> Request RebootNode
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 RebootNode
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RebootNode)))
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 Cluster -> Int -> RebootNodeResponse
RebootNodeResponse'
            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
"Cluster")
            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 RebootNode where
  hashWithSalt :: Int -> RebootNode -> Int
hashWithSalt Int
_salt RebootNode' {Text
nodeId :: Text
clusterName :: Text
$sel:nodeId:RebootNode' :: RebootNode -> Text
$sel:clusterName:RebootNode' :: RebootNode -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
nodeId

instance Prelude.NFData RebootNode where
  rnf :: RebootNode -> ()
rnf RebootNode' {Text
nodeId :: Text
clusterName :: Text
$sel:nodeId:RebootNode' :: RebootNode -> Text
$sel:clusterName:RebootNode' :: RebootNode -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
clusterName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
nodeId

instance Data.ToHeaders RebootNode where
  toHeaders :: RebootNode -> 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
"AmazonDAXV3.RebootNode" :: 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 RebootNode where
  toJSON :: RebootNode -> Value
toJSON RebootNode' {Text
nodeId :: Text
clusterName :: Text
$sel:nodeId:RebootNode' :: RebootNode -> Text
$sel:clusterName:RebootNode' :: RebootNode -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ClusterName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clusterName),
            forall a. a -> Maybe a
Prelude.Just (Key
"NodeId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
nodeId)
          ]
      )

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

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

-- | /See:/ 'newRebootNodeResponse' smart constructor.
data RebootNodeResponse = RebootNodeResponse'
  { -- | A description of the DAX cluster after a node has been rebooted.
    RebootNodeResponse -> Maybe Cluster
cluster :: Prelude.Maybe Cluster,
    -- | The response's http status code.
    RebootNodeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RebootNodeResponse -> RebootNodeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RebootNodeResponse -> RebootNodeResponse -> Bool
$c/= :: RebootNodeResponse -> RebootNodeResponse -> Bool
== :: RebootNodeResponse -> RebootNodeResponse -> Bool
$c== :: RebootNodeResponse -> RebootNodeResponse -> Bool
Prelude.Eq, ReadPrec [RebootNodeResponse]
ReadPrec RebootNodeResponse
Int -> ReadS RebootNodeResponse
ReadS [RebootNodeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RebootNodeResponse]
$creadListPrec :: ReadPrec [RebootNodeResponse]
readPrec :: ReadPrec RebootNodeResponse
$creadPrec :: ReadPrec RebootNodeResponse
readList :: ReadS [RebootNodeResponse]
$creadList :: ReadS [RebootNodeResponse]
readsPrec :: Int -> ReadS RebootNodeResponse
$creadsPrec :: Int -> ReadS RebootNodeResponse
Prelude.Read, Int -> RebootNodeResponse -> ShowS
[RebootNodeResponse] -> ShowS
RebootNodeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RebootNodeResponse] -> ShowS
$cshowList :: [RebootNodeResponse] -> ShowS
show :: RebootNodeResponse -> String
$cshow :: RebootNodeResponse -> String
showsPrec :: Int -> RebootNodeResponse -> ShowS
$cshowsPrec :: Int -> RebootNodeResponse -> ShowS
Prelude.Show, forall x. Rep RebootNodeResponse x -> RebootNodeResponse
forall x. RebootNodeResponse -> Rep RebootNodeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RebootNodeResponse x -> RebootNodeResponse
$cfrom :: forall x. RebootNodeResponse -> Rep RebootNodeResponse x
Prelude.Generic)

-- |
-- Create a value of 'RebootNodeResponse' 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:
--
-- 'cluster', 'rebootNodeResponse_cluster' - A description of the DAX cluster after a node has been rebooted.
--
-- 'httpStatus', 'rebootNodeResponse_httpStatus' - The response's http status code.
newRebootNodeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RebootNodeResponse
newRebootNodeResponse :: Int -> RebootNodeResponse
newRebootNodeResponse Int
pHttpStatus_ =
  RebootNodeResponse'
    { $sel:cluster:RebootNodeResponse' :: Maybe Cluster
cluster = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RebootNodeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A description of the DAX cluster after a node has been rebooted.
rebootNodeResponse_cluster :: Lens.Lens' RebootNodeResponse (Prelude.Maybe Cluster)
rebootNodeResponse_cluster :: Lens' RebootNodeResponse (Maybe Cluster)
rebootNodeResponse_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RebootNodeResponse' {Maybe Cluster
cluster :: Maybe Cluster
$sel:cluster:RebootNodeResponse' :: RebootNodeResponse -> Maybe Cluster
cluster} -> Maybe Cluster
cluster) (\s :: RebootNodeResponse
s@RebootNodeResponse' {} Maybe Cluster
a -> RebootNodeResponse
s {$sel:cluster:RebootNodeResponse' :: Maybe Cluster
cluster = Maybe Cluster
a} :: RebootNodeResponse)

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

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